Add a new function 'buffer-line-statistics'

* src/fns.c (Fbuffer_line_statistics): New function.

diff --git a/etc/NEWS b/etc/NEWS
index f2aa158d9d63e9e87d359fb1935eb17ce3d0ea16..fc7dcbcf4c67e528ca81919e5746300658de76ab 100644 (file)
--- 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 5fcc54f0d1faf2559bc5ec385869ae06ce15197a..7ab2e8f1a0363ca1d3facfaaa99cf3ca87e646db 100644 (file)
--- 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 a9daf878b8127acc71e8fa7fc1d2d89e31bfc36d..e0aed2a71b65615843f75576be39487804f3a1e2 100644 (file)
--- 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)))))