From b68d52c81b53ebe993620e1b80a1c923987b089b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 20 Dec 2020 23:21:51 -0500 Subject: * lisp/emacs-lisp/lisp-mnt.el (lm-section-end): Stop at the right heading `lisp-outline-level` assumes the match-data is that set by `outline-regexp`. --- lisp/emacs-lisp/lisp-mnt.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 0d57bc16a3a..f1901563429 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -208,6 +208,7 @@ a section." (when start (save-excursion (goto-char start) + (looking-at outline-regexp) (let ((level (lisp-outline-level)) (case-fold-search t) next-section-found) @@ -218,6 +219,7 @@ a section." nil t)) (> (save-excursion (beginning-of-line) + (looking-at outline-regexp) (lisp-outline-level)) level))) (min (if next-section-found -- cgit v1.2.3 From 269cec13a2fc6ac18b675d0dadd07a3d4e074a72 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 25 Dec 2020 05:16:46 +0100 Subject: Remove `string-slice' -- it's not very well defined * doc/lispref/strings.texi (Creating Strings): Ditto. * lisp/emacs-lisp/subr-x.el (string-slice): Remove. --- doc/lispref/strings.texi | 11 ----------- etc/NEWS | 2 +- lisp/emacs-lisp/shortdoc.el | 3 --- lisp/emacs-lisp/subr-x.el | 13 ------------- test/lisp/emacs-lisp/subr-x-tests.el | 8 -------- 5 files changed, 1 insertion(+), 36 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index ef848ac5107..19b91471ed3 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -381,17 +381,6 @@ The default value of @var{separators} for @code{split-string}. Its usual value is @w{@code{"[ \f\t\n\r\v]+"}}. @end defvar -@defun string-slice string regexp -Split @var{string} into a list of strings on @var{regexp} boundaries. -As opposed to @code{split-string}, the boundaries are included in the -result set: - -@example -(string-slice " two words " " +") - @result{} (" two" " words" " ") -@end example -@end defun - @defun string-clean-whitespace string Clean up the whitespace in @var{string} by collapsing stretches of whitespace to a single space character, as well as removing all diff --git a/etc/NEWS b/etc/NEWS index b155ff9d42e..3a0102238ca 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1467,7 +1467,7 @@ This can be set to nil to inhibit hiding passwords in .authinfo files. +++ *** A number of new string manipulation functions have been added. 'string-clean-whitespace', 'string-fill', 'string-limit', -'string-lines', 'string-pad', 'string-chop-newline' and 'string-slice'. +'string-lines', 'string-pad' and 'string-chop-newline'. +++ *** New variable 'current-minibuffer-command'. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 0067495fea0..618465513da 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -154,9 +154,6 @@ There can be any number of :example/:result elements." :eval (split-string "foo bar") :eval (split-string "|foo|bar|" "|") :eval (split-string "|foo|bar|" "|" t)) - (string-slice - :eval (string-slice "foo-bar" "-") - :eval (string-slice "foo-bar--zot-" "-+")) (string-lines :eval (string-lines "foo\n\nbar") :eval (string-lines "foo\n\nbar" t)) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 7e17a3464e6..dc5840a0865 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -310,19 +310,6 @@ than this function." If OMIT-NULLS, empty lines will be removed from the results." (split-string string "\n" omit-nulls)) -(defun string-slice (string regexp) - "Split STRING at REGEXP boundaries and return a list of slices. -The boundaries that match REGEXP are included in the result. - -Also see `split-string'." - (if (zerop (length string)) - (list "") - (let ((i (string-match-p regexp string 1))) - (if i - (cons (substring string 0 i) - (string-slice (substring string i) regexp)) - (list string))))) - (defun string-pad (string length &optional padding start) "Pad STRING to LENGTH using PADDING. If PADDING is nil, the space character is used. If not nil, it diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index 3fc5f1d3ed3..2ae492ecf15 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -604,14 +604,6 @@ (should (equal (string-lines "foo") '("foo"))) (should (equal (string-lines "foo \nbar") '("foo " "bar")))) -(ert-deftest subr-string-slice () - (should (equal (string-slice "foo-bar" "-") '("foo" "-bar"))) - (should (equal (string-slice "foo-bar-" "-") '("foo" "-bar" "-"))) - (should (equal (string-slice "-foo-bar-" "-") '("-foo" "-bar" "-"))) - (should (equal (string-slice "ooo" "lala") '("ooo"))) - (should (equal (string-slice "foo bar" "\\b") '("foo" " " "bar" ""))) - (should (equal (string-slice "foo bar" "\\b\\|a") '("foo" " " "b" "ar" "")))) - (ert-deftest subr-string-pad () (should (equal (string-pad "foo" 5) "foo ")) (should (equal (string-pad "foo" 5 ?-) "foo--")) -- cgit v1.2.3 From af359de91772478587f768300ca61d64a693fedb Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 25 Dec 2020 05:58:09 +0100 Subject: Allow `string-limit' to work on encoded strings * doc/lispref/strings.texi (Creating Strings): Document it. * lisp/emacs-lisp/subr-x.el (string-limit): Allow limiting on encoded strings. --- doc/lispref/strings.texi | 9 ++++++++- lisp/emacs-lisp/shortdoc.el | 3 ++- lisp/emacs-lisp/subr-x.el | 34 +++++++++++++++++++++++++++++----- test/lisp/emacs-lisp/subr-x-tests.el | 20 ++++++++++++++++++++ 4 files changed, 59 insertions(+), 7 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 19b91471ed3..1e5f52ddfdd 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -394,12 +394,19 @@ there are individual words that are longer than @var{length}, these will not be shortened. @end defun -@defun string-limit string length &optional end +@defun string-limit string length &optional end coding-system If @var{string} is shorter than @var{length}, @var{string} is returned as is. Otherwise, return a substring of @var{string} consisting of the first @var{length} characters. If the optional @var{end} parameter is given, return a string of the @var{length} last characters instead. + +If @var{coding-system} is non-@code{nil}, @var{string} will be encoded +before limiting, and the result will be a unibyte string that's +shorter than @code{length}. If @var{string} contains characters that +are encoded into several bytes (for instance, when using +@code{utf-8}), the resulting unibyte string is never truncated in the +middle of a character representation. @end defun @defun string-lines string &optional omit-nulls diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 618465513da..9d183e0d4e9 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -146,7 +146,8 @@ There can be any number of :example/:result elements." (string-limit :eval (string-limit "foobar" 3) :eval (string-limit "foobar" 3 t) - :eval (string-limit "foobar" 10)) + :eval (string-limit "foobar" 10) + :eval (string-limit "fo好" 3 nil 'utf-8)) (truncate-string-to-width :eval (truncate-string-to-width "foobar" 3) :eval (truncate-string-to-width "你好bar" 5)) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index dc5840a0865..9fbb0351af4 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -286,7 +286,7 @@ result will have lines that are longer than LENGTH." (fill-region (point-min) (point-max))) (buffer-string))) -(defun string-limit (string length &optional end) +(defun string-limit (string length &optional end coding-system) "Return (up to) a LENGTH substring of STRING. If STRING is shorter than or equal to LENGTH, the entire string is returned unchanged. @@ -295,15 +295,39 @@ If STRING is longer than LENGTH, return a substring consisting of the first LENGTH characters of STRING. If END is non-nil, return the last LENGTH characters instead. +If CODING-SYSTEM is non-nil, STRING will be encoded before +limiting, and LENGTH is interpreted as the number of bytes to +limit the string to. The result will be a unibyte string that is +shorter than LENGTH, but will not contain \"partial\" characters, +even if CODING-SYSTEM encodes characters with several bytes per +character. + When shortening strings for display purposes, `truncate-string-to-width' is almost always a better alternative than this function." (unless (natnump length) (signal 'wrong-type-argument (list 'natnump length))) - (cond - ((<= (length string) length) string) - (end (substring string (- (length string) length))) - (t (substring string 0 length)))) + (if coding-system + (let ((result nil) + (result-length 0) + (index (if end (1- (length string)) 0))) + (while (let ((encoded (encode-coding-char + (aref string index) coding-system))) + (and (<= (+ (length encoded) result-length) length) + (progn + (push encoded result) + (cl-incf result-length (length encoded)) + (setq index (if end (1- index) + (1+ index)))) + (if end (> index -1) + (< index (length string))))) + ;; No body. + ) + (apply #'concat (if end result (nreverse result)))) + (cond + ((<= (length string) length) string) + (end (substring string (- (length string) length))) + (t (substring string 0 length))))) (defun string-lines (string &optional omit-nulls) "Split STRING into a list of lines. diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index 2ae492ecf15..b17185ab0d3 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -600,6 +600,26 @@ (should (equal (string-limit "foo" 0) "")) (should-error (string-limit "foo" -1))) +(ert-deftest subr-string-limit-coding () + (should (not (multibyte-string-p (string-limit "foó" 10 nil 'utf-8)))) + (should (equal (string-limit "foó" 10 nil 'utf-8) "fo\303\263")) + (should (equal (string-limit "foó" 3 nil 'utf-8) "fo")) + (should (equal (string-limit "foó" 4 nil 'utf-8) "fo\303\263")) + (should (equal (string-limit "foóa" 4 nil 'utf-8) "fo\303\263")) + (should (equal (string-limit "foóá" 4 nil 'utf-8) "fo\303\263")) + (should (equal (string-limit "foóa" 4 nil 'iso-8859-1) "fo\363a")) + (should (equal (string-limit "foóá" 4 nil 'iso-8859-1) "fo\363\341")) + (should (equal (string-limit "foóá" 4 nil 'utf-16) "\376\377\000f")) + + (should (equal (string-limit "foó" 10 t 'utf-8) "fo\303\263")) + (should (equal (string-limit "foó" 3 t 'utf-8) "o\303\263")) + (should (equal (string-limit "foó" 4 t 'utf-8) "fo\303\263")) + (should (equal (string-limit "foóa" 4 t 'utf-8) "o\303\263a")) + (should (equal (string-limit "foóá" 4 t 'utf-8) "\303\263\303\241")) + (should (equal (string-limit "foóa" 4 t 'iso-8859-1) "fo\363a")) + (should (equal (string-limit "foóá" 4 t 'iso-8859-1) "fo\363\341")) + (should (equal (string-limit "foóá" 4 t 'utf-16) "\376\377\000\341"))) + (ert-deftest subr-string-lines () (should (equal (string-lines "foo") '("foo"))) (should (equal (string-lines "foo \nbar") '("foo " "bar")))) -- cgit v1.2.3 From 443a53874b8cca1b382509fde1f0f8f70f56e916 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 25 Dec 2020 22:29:42 +0100 Subject: Refactor package--list-loaded-files for easier debuggability * lisp/emacs-lisp/package.el (package--files-load-history) (package--list-of-conflicts): Factor out from... (package--list-loaded-files): ... this function for easier debuggability. --- lisp/emacs-lisp/package.el | 53 +++++++++++++++++++++++++--------------------- 1 file changed, 29 insertions(+), 24 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index fa93ffd0cc5..0170e61e126 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -825,40 +825,45 @@ correspond to previously loaded files (those returned by (declare-function find-library-name "find-func" (library)) +(defun package--files-load-history () + (delq nil + (mapcar (lambda (x) + (let ((f (car x))) + (and (stringp f) + (file-name-sans-extension f)))) + load-history))) + +(defun package--list-of-conflicts (dir history) + (delq + nil + (mapcar + (lambda (x) (let* ((file (file-relative-name x dir)) + ;; Previously loaded file, if any. + (previous + (ignore-errors + (file-name-sans-extension + (file-truename (find-library-name file))))) + (pos (when previous (member previous history)))) + ;; Return (RELATIVE-FILENAME . HISTORY-POSITION) + (when pos + (cons (file-name-sans-extension file) (length pos))))) + (directory-files-recursively dir "\\`[^\\.].*\\.el\\'")))) + (defun package--list-loaded-files (dir) "Recursively list all files in DIR which correspond to loaded features. Returns the `file-name-sans-extension' of each file, relative to DIR, sorted by most recently loaded last." - (let* ((history (delq nil - (mapcar (lambda (x) - (let ((f (car x))) - (and (stringp f) - (file-name-sans-extension f)))) - load-history))) + (let* ((history (package--files-load-history)) (dir (file-truename dir)) ;; List all files that have already been loaded. - (list-of-conflicts - (delq - nil - (mapcar - (lambda (x) (let* ((file (file-relative-name x dir)) - ;; Previously loaded file, if any. - (previous - (ignore-errors - (file-name-sans-extension - (file-truename (find-library-name file))))) - (pos (when previous (member previous history)))) - ;; Return (RELATIVE-FILENAME . HISTORY-POSITION) - (when pos - (cons (file-name-sans-extension file) (length pos))))) - (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))))) + (list-of-conflicts (package--list-of-conflicts dir history))) ;; Turn the list of (FILENAME . POS) back into a list of features. Files in ;; subdirectories are returned relative to DIR (so not actually features). (let ((default-directory (file-name-as-directory dir))) (mapcar (lambda (x) (file-truename (car x))) - (sort list-of-conflicts - ;; Sort the files by ascending HISTORY-POSITION. - (lambda (x y) (< (cdr x) (cdr y)))))))) + (sort list-of-conflicts + ;; Sort the files by ascending HISTORY-POSITION. + (lambda (x y) (< (cdr x) (cdr y)))))))) ;;;; `package-activate' ;; This function activates a newer version of a package if an older -- cgit v1.2.3 From d18b1c8c7583b981d4f3d687e49e82250d51634f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 25 Dec 2020 22:44:56 +0100 Subject: Fix package reloading problems on systems with symlinks * lisp/emacs-lisp/package.el (package--files-load-history): We're comparing the truenames, so ensure that we've using that everywhere. This fixes problems when there's symlinks in the paths. --- lisp/emacs-lisp/package.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 0170e61e126..bc450b09d01 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -830,7 +830,7 @@ correspond to previously loaded files (those returned by (mapcar (lambda (x) (let ((f (car x))) (and (stringp f) - (file-name-sans-extension f)))) + (file-name-sans-extension (file-truename f))))) load-history))) (defun package--list-of-conflicts (dir history) -- cgit v1.2.3 From 90e40099debaa876273ae560ed8e66985719dd0c Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 26 Dec 2020 00:57:01 +0100 Subject: Fix infloop in memory-report * lisp/emacs-lisp/memory-report.el (memory-report--object-size-1): Fix infloop on circular lists. --- lisp/emacs-lisp/memory-report.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el index b532ddc56c5..332749987c4 100644 --- a/lisp/emacs-lisp/memory-report.el +++ b/lisp/emacs-lisp/memory-report.el @@ -204,7 +204,9 @@ by counted more than once." (cl-incf total (memory-report--object-size counted (car value)))) (if (cdr value) (if (consp (cdr value)) - (setq value (cdr value)) + (if (gethash (cdr value) counted) + (setq value nil) + (setq value (cdr value))) (cl-incf total (memory-report--object-size counted (cdr value))) (setq value nil)) (setq value nil))) -- cgit v1.2.3 From 714ca849ba658405ddde698cdc5836c4c9b289ca Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 26 Dec 2020 23:13:29 +0100 Subject: Improve the edebug-form-data doc string * lisp/emacs-lisp/edebug.el (edebug-form-data): Doc string clarification (bug#42776). --- lisp/emacs-lisp/edebug.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index f242e922bde..8e5ece3605d 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -592,7 +592,7 @@ already is one.)" "A list of entries associating symbols with buffer regions. Each entry is an `edebug--form-data' struct with fields: SYMBOL, BEGIN-MARKER, and END-MARKER. The markers -are at the beginning and end of an entry level form and SYMBOL is +are at the beginning and end of an instrumented form and SYMBOL is a symbol that holds all edebug related information for the form on its property list. -- cgit v1.2.3 From 0f790464d547dd57a857d88dab309b286067ac45 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 27 Dec 2020 09:00:23 +0100 Subject: Add new predicates for sequence lengths * doc/lispref/sequences.texi (Sequence Functions): Document them. * lisp/emacs-lisp/byte-opt.el (side-effect-free-fns): Mark them as side-effect-free. * lisp/emacs-lisp/shortdoc.el (list): Mention them. * src/fns.c (Flength): Mention them in the doc string. (length_internal): New function. (Flength_less, Flength_greater, Flength_equal): New defuns. (syms_of_fns): Sym them. --- doc/lispref/sequences.texi | 15 +++++++++ etc/NEWS | 6 ++++ lisp/emacs-lisp/byte-opt.el | 4 ++- lisp/emacs-lisp/shortdoc.el | 6 ++++ src/fns.c | 76 ++++++++++++++++++++++++++++++++++++++++++++- test/src/fns-tests.el | 30 ++++++++++++++++++ 6 files changed, 135 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 952834bd4e3..57b49847e7f 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -116,6 +116,21 @@ If you need to compute the width of a string on display, you should use since @code{length} only counts the number of characters, but does not account for the display width of each character. +@defun length< sequence length +Return non-@code{nil} if @var{sequence} is shorter than @var{length}. +This may be more efficient than computing the length of @var{sequence} +if @var{sequence} is a long list. +@end defun + +@defun length> sequence length +Return non-@code{nil} if @var{sequence} is longer than @var{length}. +@end defun + +@defun length= sequence length +Return non-@code{nil} if the length of @var{sequence} is equal to +@var{length}. +@end defun + @defun elt sequence index @anchor{Definition of elt} @cindex elements of sequences diff --git a/etc/NEWS b/etc/NEWS index d24d8b1f0a2..9ae8cc91d63 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1460,6 +1460,12 @@ that makes it a valid button. ** Miscellaneous ++++ +*** New predicate functions 'length<', 'length>' and 'length='. +Using these functions may be more efficient than using 'length' (if +the length of a (long) list is being computed just to compare this +length to a number). + --- *** 'remove-hook' is now an interactive command. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 469bbe6c7c0..0eee6e9d015 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1169,7 +1169,9 @@ hash-table-count int-to-string intern-soft isnan keymap-parent - lax-plist-get ldexp length line-beginning-position line-end-position + lax-plist-get ldexp + length length< length> length= + line-beginning-position line-end-position local-variable-if-set-p local-variable-p locale-info log log10 logand logb logcount logior lognot logxor lsh make-byte-code make-list make-string make-symbol marker-buffer max diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 9d183e0d4e9..c6259f89711 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -618,6 +618,12 @@ There can be any number of :example/:result elements." "Data About Lists" (length :eval (length '(a b c))) + (length< + :eval (lenth< '(a b c) 1)) + (length> + :eval (lenth> '(a b c) 1)) + (length= + :eval (lenth> '(a b c) 3)) (safe-length :eval (safe-length '(a b c)))) diff --git a/src/fns.c b/src/fns.c index 646c3ed0834..0fded92aeb2 100644 --- a/src/fns.c +++ b/src/fns.c @@ -105,9 +105,14 @@ list_length (Lisp_Object list) DEFUN ("length", Flength, Slength, 1, 1, 0, doc: /* Return the length of vector, list or string SEQUENCE. A byte-code function object is also allowed. + If the string contains multibyte characters, this is not necessarily the number of bytes in the string; it is the number of characters. -To get the number of bytes, use `string-bytes'. */) +To get the number of bytes, use `string-bytes'. + +If the length of a list is being computed to compare to a (small) +number, the `string<', `string>' and `string=' functions may be more +efficient. */) (Lisp_Object sequence) { EMACS_INT val; @@ -145,6 +150,72 @@ least the number of distinct elements. */) return make_fixnum (len); } +static inline +EMACS_INT length_internal (Lisp_Object sequence, int len) +{ + /* If LENGTH is short (arbitrarily chosen cut-off point), use a + fast loop that doesn't care about whether SEQUENCE is + circular or not. */ + if (len < 0xffff) + while (CONSP (sequence)) + { + if (--len == 0) + return -1; + sequence = XCDR (sequence); + } + /* Signal an error on circular lists. */ + else + FOR_EACH_TAIL (sequence) + if (--len == 0) + return -1; + return len; +} + +DEFUN ("length<", Flength_less, Slength_less, 2, 2, 0, + doc: /* Return non-nil if SEQUENCE is shorter than LENGTH. +See `length' for allowed values of SEQUENCE and how elements are +counted. */) + (Lisp_Object sequence, Lisp_Object length) +{ + CHECK_FIXNUM (length); + EMACS_INT len = XFIXNUM (length); + + if (CONSP (sequence)) + return length_internal (sequence, len) == -1? Qnil: Qt; + else + return XFIXNUM (Flength (sequence)) < len? Qt: Qnil; +} + +DEFUN ("length>", Flength_greater, Slength_greater, 2, 2, 0, + doc: /* Return non-nil if SEQUENCE is longer than LENGTH. +See `length' for allowed values of SEQUENCE and how elements are +counted. */) + (Lisp_Object sequence, Lisp_Object length) +{ + CHECK_FIXNUM (length); + EMACS_INT len = XFIXNUM (length); + + if (CONSP (sequence)) + return length_internal (sequence, len + 1) == -1? Qt: Qnil; + else + return XFIXNUM (Flength (sequence)) > len? Qt: Qnil; +} + +DEFUN ("length=", Flength_equal, Slength_equal, 2, 2, 0, + doc: /* Return non-nil if SEQUENCE is equal to LENGTH. +See `length' for allowed values of SEQUENCE and how elements are +counted. */) + (Lisp_Object sequence, Lisp_Object length) +{ + CHECK_FIXNUM (length); + EMACS_INT len = XFIXNUM (length); + + if (CONSP (sequence)) + return length_internal (sequence, len + 1) == 1? Qt: Qnil; + else + return XFIXNUM (Flength (sequence)) == len? Qt: Qnil; +} + DEFUN ("proper-list-p", Fproper_list_p, Sproper_list_p, 1, 1, 0, doc: /* Return OBJECT's length if it is a proper list, nil otherwise. A proper list is neither circular nor dotted (i.e., its last cdr is nil). */ @@ -5721,6 +5792,9 @@ this variable. */); defsubr (&Srandom); defsubr (&Slength); defsubr (&Ssafe_length); + defsubr (&Slength_less); + defsubr (&Slength_greater); + defsubr (&Slength_equal); defsubr (&Sproper_list_p); defsubr (&Sstring_bytes); defsubr (&Sstring_distance); diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index eaa569e0d95..3486c745bf3 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -999,3 +999,33 @@ (object-intervals (current-buffer))) '((0 1 (foo 1)) (1 2 (zot 3 foo 1)) (2 4 (zot 3 bar 2)) (4 5 (bar 2)) (5 6 nil))))) + +(ert-deftest length-equals-tests () + (should-not (length< (list 1 2 3) 2)) + (should-not (length< (list 1 2 3) 3)) + (should (length< (list 1 2 3) 4)) + + (should-not (length< "abc" 2)) + (should-not (length< "abc" 3)) + (should (length< "abc" 4)) + + (should (length> (list 1 2 3) 2)) + (should-not (length> (list 1 2 3) 3)) + (should-not (length> (list 1 2 3) 4)) + + (should (length> "abc" 2)) + (should-not (length> "abc" 3)) + (should-not (length> "abc" 4)) + + (should-not (length= (list 1 2 3) 2)) + (should (length= (list 1 2 3) 3)) + (should-not (length= (list 1 2 3) 4)) + + (should-not (length= "abc" 2)) + (should (length= "abc" 3)) + (should-not (length= "abc" 4)) + + (should-error + (let ((list (list 1))) + (setcdr list list) + (length< list #x1fffe)))) -- cgit v1.2.3 From 80420faf4921ffe5e9d4c4f9595941acf3156e50 Mon Sep 17 00:00:00 2001 From: Daniel Martín Date: Sun, 27 Dec 2020 09:04:56 +0100 Subject: Improve "find definition" in *Help* buffers * lisp/emacs-lisp/find-func.el (find-function-search-for-symbol): If our regexp algorithm could not find a location for the symbol definition, resort to find-function--search-by-expanding-macros. * test/lisp/emacs-lisp/find-func-tests.el: Add a automatic test for a function and variable generated by a macro. * etc/NEWS: Advertise the improved functionality (bug#45443). --- etc/NEWS | 6 +++ lisp/emacs-lisp/find-func.el | 65 ++++++++++++++++++++++++++++++++- test/lisp/emacs-lisp/find-func-tests.el | 10 +++++ 3 files changed, 80 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/etc/NEWS b/etc/NEWS index 9ae8cc91d63..4f072df31c5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -114,6 +114,12 @@ choosing a group, or clicking a button in the "*Help*" buffers when looking at the doc string of a function that belongs to one of these groups. +--- +** Improved "find definition" feature of *Help* buffers. +Now clicking on the link to find the definition of functions generated +by 'cl-defstruct', or variables generated by 'define-derived-mode', +for example, will go to the exact place where they are defined. + ** New variable 'redisplay-skip-initial-frame' to enable batch redisplay tests. Setting it to nil forces the redisplay to do its job even in the initial frame used in batch mode. diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 074e7db295b..7796a72ecfd 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -389,7 +389,70 @@ The search is done in the source for library LIBRARY." (progn (beginning-of-line) (cons (current-buffer) (point))) - (cons (current-buffer) nil))))))))) + ;; If the regexp search didn't find the location of + ;; the symbol (for example, because it is generated by + ;; a macro), try a slightly more expensive search that + ;; expands macros until it finds the symbol. + (cons (current-buffer) + (find-function--search-by-expanding-macros + (current-buffer) symbol type)))))))))) + +(defun find-function--try-macroexpand (form) + "Try to macroexpand FORM in full or partially. +This is a best-effort operation in which if macroexpansion fails, +this function returns FORM as is." + (ignore-errors + (or + (macroexpand-all form) + (macroexpand-1 form) + form))) + +(defun find-function--any-subform-p (form pred) + "Walk FORM and apply PRED to its subexpressions. +Return t if any PRED returns t." + (cond + ((not (consp form)) nil) + ((funcall pred form) t) + (t + (cl-destructuring-bind (left-child . right-child) form + (or + (find-function--any-subform-p left-child pred) + (find-function--any-subform-p right-child pred)))))) + +(defun find-function--search-by-expanding-macros (buf symbol type) + "Expand macros in BUF to search for the definition of SYMBOL of TYPE." + (catch 'found + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (condition-case nil + (while t + (let ((form (read (current-buffer))) + (expected-symbol-p + (lambda (form) + (cond + ((null type) + ;; Check if a given form is a `defalias' to + ;; SYM, the function name we are searching + ;; for. All functions in Emacs Lisp + ;; ultimately expand to a `defalias' form + ;; after several steps of macroexpansion. + (and (eq (car-safe form) 'defalias) + (equal (car-safe (cdr form)) + `(quote ,symbol)))) + ((eq type 'defvar) + ;; Variables generated by macros ultimately + ;; expand to `defvar'. + (and (eq (car-safe form) 'defvar) + (eq (car-safe (cdr form)) symbol))) + (t nil))))) + (when (find-function--any-subform-p + (find-function--try-macroexpand form) + expected-symbol-p) + ;; We want to return the location at the beginning + ;; of the macro, so move back one sexp. + (throw 'found (progn (backward-sexp) (point)))))) + (end-of-file nil)))))) (defun find-function-library (function &optional lisp-only verbose) "Return the pair (ORIG-FUNCTION . LIBRARY) for FUNCTION. diff --git a/test/lisp/emacs-lisp/find-func-tests.el b/test/lisp/emacs-lisp/find-func-tests.el index d77eb6757ff..03df4bb9ff4 100644 --- a/test/lisp/emacs-lisp/find-func-tests.el +++ b/test/lisp/emacs-lisp/find-func-tests.el @@ -43,5 +43,15 @@ (concat data-directory (kbd "n x / TAB RET")) (read-library-name))))) +;; Avoid a byte-compilation warning that may confuse people reading +;; the result of the following test. +(declare-function compilation--message->loc nil "compile") + +(ert-deftest find-func-tests--locate-macro-generated-symbols () ;bug#45443 + (should (cdr (find-function-search-for-symbol + #'compilation--message->loc nil "compile"))) + (should (cdr (find-function-search-for-symbol + 'c-mode-hook 'defvar "cc-mode")))) + (provide 'find-func-tests) ;;; find-func-tests.el ends here -- cgit v1.2.3 From df882c9701755e2ae063f05d3381de14ae09951e Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sun, 27 Dec 2020 13:14:30 +0000 Subject: ; Fix recent shortdoc.el and fns.c additions * lisp/emacs-lisp/shortdoc.el (list): Fix typos. * src/fns.c (Flength_equal): Fix docstring. --- lisp/emacs-lisp/shortdoc.el | 6 +++--- src/fns.c | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index c6259f89711..7fb1a88b861 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -619,11 +619,11 @@ There can be any number of :example/:result elements." (length :eval (length '(a b c))) (length< - :eval (lenth< '(a b c) 1)) + :eval (length< '(a b c) 1)) (length> - :eval (lenth> '(a b c) 1)) + :eval (length> '(a b c) 1)) (length= - :eval (lenth> '(a b c) 3)) + :eval (length> '(a b c) 3)) (safe-length :eval (safe-length '(a b c)))) diff --git a/src/fns.c b/src/fns.c index 217e3b62cca..2de1d26dd31 100644 --- a/src/fns.c +++ b/src/fns.c @@ -202,7 +202,7 @@ counted. */) } DEFUN ("length=", Flength_equal, Slength_equal, 2, 2, 0, - doc: /* Return non-nil if SEQUENCE is equal to LENGTH. + doc: /* Return non-nil if SEQUENCE has length equal to LENGTH. See `length' for allowed values of SEQUENCE and how elements are counted. */) (Lisp_Object sequence, Lisp_Object length) -- cgit v1.2.3