[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 792ba71: Add a new function 'buffer-line-statistics'
From: |
Lars Ingebrigtsen |
Subject: |
master 792ba71: Add a new function 'buffer-line-statistics' |
Date: |
Tue, 12 Jan 2021 12:47:49 -0500 (EST) |
branch: master
commit 792ba7196ff1171f44571d9ba9b88b96d5be85ad
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Add a new function 'buffer-line-statistics'
* src/fns.c (Fbuffer_line_statistics): New function.
---
etc/NEWS | 3 ++
src/fns.c | 85 +++++++++++++++++++++++++++++++++++++++++++++++++++
test/src/fns-tests.el | 58 +++++++++++++++++++++++++++++++++++
3 files changed, 146 insertions(+)
diff --git a/etc/NEWS b/etc/NEWS
index f2aa158..fc7dcbc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1537,6 +1537,9 @@ that makes it a valid button.
** Miscellaneous
+*** New function 'buffer-line-statistics'.
+This function returns some statistics about the line lengths in a buffer.
+
+++
*** New variable 'inhibit-interaction' to make user prompts signal an error.
If this is bound to something non-nil, functions like
diff --git a/src/fns.c b/src/fns.c
index 5fcc54f..7ab2e8f 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5548,6 +5548,90 @@ It should not be used for anything security-related. See
return make_digest_string (digest, SHA1_DIGEST_SIZE);
}
+DEFUN ("buffer-line-statistics", Fbuffer_line_statistics,
+ Sbuffer_line_statistics, 0, 1, 0,
+ doc: /* Return data about lines in BUFFER.
+The data is returned as a list, and the first element is the number of
+lines in the buffer, the second is the length of the longest line, and
+the third is the mean line length. The lengths returned are in bytes, not
+characters. */ )
+ (Lisp_Object buffer_or_name)
+{
+ Lisp_Object buffer;
+ ptrdiff_t lines = 0, longest = 0;
+ double mean = 0;
+ struct buffer *b;
+
+ if (NILP (buffer_or_name))
+ buffer = Fcurrent_buffer ();
+ else
+ buffer = Fget_buffer (buffer_or_name);
+ if (NILP (buffer))
+ nsberror (buffer_or_name);
+
+ b = XBUFFER (buffer);
+
+ unsigned char *start = BUF_BEG_ADDR (b);
+ ptrdiff_t area = BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b), pre_gap = 0;
+
+ /* Process the first part of the buffer. */
+ while (area > 0)
+ {
+ unsigned char *n = memchr (start, '\n', area);
+
+ if (n)
+ {
+ ptrdiff_t this_line = n - start;
+ if (this_line > longest)
+ longest = this_line;
+ lines++;
+ /* Blame Knuth. */
+ mean = mean + (this_line - mean) / lines;
+ area = area - this_line - 1;
+ start += this_line + 1;
+ }
+ else
+ {
+ /* Didn't have a newline here, so save the rest for the
+ post-gap calculation. */
+ pre_gap = area;
+ area = 0;
+ }
+ }
+
+ /* If the gap is before the end of the buffer, process the last half
+ of the buffer. */
+ if (BUF_GPT_BYTE (b) < BUF_Z_BYTE (b))
+ {
+ start = BUF_GAP_END_ADDR (b);
+ area = BUF_Z_ADDR (b) - BUF_GAP_END_ADDR (b);
+
+ while (area > 0)
+ {
+ unsigned char *n = memchr (start, '\n', area);
+ ptrdiff_t this_line = n? n - start + pre_gap: area + pre_gap;
+
+ if (this_line > longest)
+ longest = this_line;
+ lines++;
+ /* Blame Knuth again. */
+ mean = mean + (this_line - mean) / lines;
+ area = area - this_line - 1;
+ start += this_line + 1;
+ pre_gap = 0;
+ }
+ }
+ else if (pre_gap > 0)
+ {
+ if (pre_gap > longest)
+ longest = pre_gap;
+ lines++;
+ mean = mean + (pre_gap - mean) / lines;
+ }
+
+ return list3 (make_int (lines), make_int (longest), make_float (mean));
+}
+
static bool
string_ascii_p (Lisp_Object string)
{
@@ -5871,4 +5955,5 @@ this variable. */);
defsubr (&Ssecure_hash);
defsubr (&Sbuffer_hash);
defsubr (&Slocale_info);
+ defsubr (&Sbuffer_line_statistics);
}
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index a9daf87..e0aed2a 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -1040,3 +1040,61 @@
(let ((list (list 1)))
(setcdr list list)
(length< list #x1fffe))))
+
+(defun approx-equal (list1 list2)
+ (and (equal (length list1) (length list2))
+ (cl-loop for v1 in list1
+ for v2 in list2
+ when (not (or (= v1 v2)
+ (< (abs (- v1 v2)) 0.1)))
+ return nil
+ finally return t)))
+
+(ert-deftest test-buffer-line-stats-nogap ()
+ (with-temp-buffer
+ (insert "")
+ (should (approx-equal (buffer-line-statistics) '(0 0 0))))
+ (with-temp-buffer
+ (insert "123\n")
+ (should (approx-equal (buffer-line-statistics) '(1 3 3))))
+ (with-temp-buffer
+ (insert "123\n12345\n123\n")
+ (should (approx-equal (buffer-line-statistics) '(3 5 3.66))))
+ (with-temp-buffer
+ (insert "123\n12345\n123")
+ (should (approx-equal (buffer-line-statistics) '(3 5 3.66))))
+ (with-temp-buffer
+ (insert "123\n12345")
+ (should (approx-equal (buffer-line-statistics) '(2 5 4))))
+
+ (with-temp-buffer
+ (insert "123\n12é45\n123\n")
+ (should (approx-equal (buffer-line-statistics) '(3 6 4))))
+
+ (with-temp-buffer
+ (insert "\n\n\n")
+ (should (approx-equal (buffer-line-statistics) '(3 0 0)))))
+
+(ert-deftest test-buffer-line-stats-gap ()
+ (with-temp-buffer
+ (dotimes (_ 1000)
+ (insert "12345678901234567890123456789012345678901234567890\n"))
+ (goto-char (point-min))
+ ;; This should make a gap appear.
+ (insert "123\n")
+ (delete-region (point-min) (point))
+ (should (approx-equal (buffer-line-statistics) '(1000 50 50.0))))
+ (with-temp-buffer
+ (dotimes (_ 1000)
+ (insert "12345678901234567890123456789012345678901234567890\n"))
+ (goto-char (point-min))
+ (insert "123\n")
+ (should (approx-equal (buffer-line-statistics) '(1001 50 49.9))))
+ (with-temp-buffer
+ (dotimes (_ 1000)
+ (insert "12345678901234567890123456789012345678901234567890\n"))
+ (goto-char (point-min))
+ (insert "123\n")
+ (goto-char (point-max))
+ (insert "fóo")
+ (should (approx-equal (buffer-line-statistics) '(1002 50 49.9)))))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 792ba71: Add a new function 'buffer-line-statistics',
Lars Ingebrigtsen <=