Commit 792ba719 authored by Lars Ingebrigtsen's avatar Lars Ingebrigtsen

Add a new function 'buffer-line-statistics'

* src/fns.c (Fbuffer_line_statistics): New function.
parent ca024b05
Pipeline #8668 passed with stage
in 49 minutes and 29 seconds
......@@ -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
......
......@@ -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);
}
......@@ -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)))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment