From 08291e6f1755837d1cc0d5ac940bd39f7bcadd43 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 29 May 2023 17:49:48 +0200 Subject: [PATCH 1/8] Clean up defcustom type quote check * lisp/emacs-lisp/bytecomp.el (byte-compile--suspicious-defcustom-choice): Rename to... (byte-compile--defcustom-type-quoted): ...this and rewrite to make more sense. All callers updated. (byte-compile-nogroup-warn): Better warning message. * test/lisp/emacs-lisp/bytecomp-tests.el (test-bytecomp-defgroup-choice): This never failed because it wasn't actually a test. Turn it into... (bytecomp-test-defcustom-type-quoted): ...this, which is. --- lisp/emacs-lisp/bytecomp.el | 29 +++++++++++++------------- test/lisp/emacs-lisp/bytecomp-tests.el | 8 +++---- 2 files changed, 18 insertions(+), 19 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ac040799a22..aea50fc8e57 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1619,21 +1619,20 @@ extra args." (dolist (elt '(format message format-message error)) (put elt 'byte-compile-format-like t)) -(defun byte-compile--suspicious-defcustom-choice (type) - "Say whether defcustom TYPE looks odd." - ;; Check whether there's anything like (choice (const :tag "foo" ;; 'bar)). +(defun byte-compile--defcustom-type-quoted (type) + "Whether defcustom TYPE contains an accidentally quoted value." + ;; Detect mistakes such as (const 'abc). ;; We don't actually follow the syntax for defcustom types, but this ;; should be good enough. - (catch 'found - (if (and (consp type) - (proper-list-p type)) - (if (memq (car type) '(const other)) - (when (assq 'quote type) - (throw 'found t)) - (when (memq t (mapcar #'byte-compile--suspicious-defcustom-choice - type)) - (throw 'found t))) - nil))) + (and (consp type) + (proper-list-p type) + (if (memq (car type) '(const other)) + (assq 'quote type) + (let ((elts (cdr type))) + (while (and elts (not (byte-compile--defcustom-type-quoted + (car elts)))) + (setq elts (cdr elts))) + elts)))) ;; Warn if a custom definition fails to specify :group, or :type. (defun byte-compile-nogroup-warn (form) @@ -1647,10 +1646,10 @@ extra args." (byte-compile-warn-x (cadr name) "defcustom for `%s' fails to specify type" (cadr name))) - ((byte-compile--suspicious-defcustom-choice type) + ((byte-compile--defcustom-type-quoted type) (byte-compile-warn-x (cadr name) - "defcustom for `%s' has syntactically odd type `%s'" + "defcustom for `%s' may have accidentally quoted value in type `%s'" (cadr name) type))))) (if (and (memq (car form) '(custom-declare-face custom-declare-variable)) byte-compile-current-group) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index a8809bda81c..963ea9abe0c 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1799,11 +1799,11 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ (TEST-IN-COMMENTS t) (TEST-IN-STRINGS t) (TEST-IN-CODE t) \ (FIXTURE-FN \\='#\\='electric-pair-mode))" fill-column))) -(defun test-bytecomp-defgroup-choice () - (should-not (byte-compile--suspicious-defcustom-choice 'integer)) - (should-not (byte-compile--suspicious-defcustom-choice +(ert-deftest bytecomp-test-defcustom-type-quoted () + (should-not (byte-compile--defcustom-type-quoted 'integer)) + (should-not (byte-compile--defcustom-type-quoted '(choice (const :tag "foo" bar)))) - (should (byte-compile--suspicious-defcustom-choice + (should (byte-compile--defcustom-type-quoted '(choice (const :tag "foo" 'bar))))) (ert-deftest bytecomp-function-attributes () From ace9f6775580459c35254607d866f3bb22a8c45b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 30 May 2023 10:04:48 +0200 Subject: [PATCH 2/8] Avoid using rx `any` for `not-newline` Despite its name, `any` does not match any character (use `anychar` for that) but is an old synonym for `not-newline` and `nonl`, retained for compatibility with the obsolete `sregex` package. (In SRE as defined by SRFI-115, `any` does match any character.) There is also a mild but unnecessary confusion with the more frequently used `any` construct for character alternatives. * lisp/edmacro.el (edmacro-mode-font-lock-keywords): * lisp/erc/erc.el (erc--ensure-url): * lisp/org/org.el (org-fontify-meta-lines-and-blocks-1): * lisp/progmodes/scheme.el (scheme-imenu-generic-expression): * test/lisp/find-cmd-tests.el (find-cmd-test-find-cmd): Replace uses of `any` with `nonl`. --- lisp/edmacro.el | 8 ++++---- lisp/erc/erc.el | 6 +++--- lisp/org/org.el | 6 +++--- lisp/progmodes/scheme.el | 2 +- test/lisp/find-cmd-tests.el | 2 +- 5 files changed, 12 insertions(+), 12 deletions(-) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 8734f7cbebe..69d20d2bad3 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -91,17 +91,17 @@ Default nil means to write characters above \\177 in octal notation." `((,(rx bol (group (or "Command" "Key" "Macro") ":")) 0 'edmacro-label) (,(rx bol (group ";; Keyboard Macro Editor. Press ") - (group (*? any)) + (group (*? nonl)) (group " to finish; press ")) (1 'font-lock-comment-face) (2 'help-key-binding) (3 'font-lock-comment-face) - (,(rx (group (*? any)) - (group " to cancel" (* any))) + (,(rx (group (*? nonl)) + (group " to cancel" (* nonl))) nil nil (1 'help-key-binding) (2 'font-lock-comment-face))) - (,(rx (one-or-more ";") (zero-or-more any)) 0 'font-lock-comment-face))) + (,(rx (one-or-more ";") (zero-or-more nonl)) 0 'font-lock-comment-face))) (defvar edmacro-store-hook) (defvar edmacro-finish-hook) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 5a91285c1d1..2c2df81fa6d 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2398,9 +2398,9 @@ parameters SERVER and NICK." (defun erc--ensure-url (input) (unless (string-match (rx bot "irc" (? "6") (? "s") "://") input) - (when (and (string-match (rx (? (+ any) "@") - (or (group (* (not "[")) ":" (* any)) - (+ any)) + (when (and (string-match (rx (? (+ nonl) "@") + (or (group (* (not "[")) ":" (* nonl)) + (+ nonl)) ":" (+ (not (any ":]"))) eot) input) (match-beginning 1)) diff --git a/lisp/org/org.el b/lisp/org/org.el index e42704778bd..b81630fdc07 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -5374,7 +5374,7 @@ by a #." (zero-or-more (any " \t")) (group (group (zero-or-more (not (any " \t\n")))) (zero-or-more (any " \t")) - (group (zero-or-more any))))) + (group (zero-or-more nonl))))) limit t) (let ((beg (match-beginning 0)) (end-of-beginline (match-end 0)) @@ -5400,7 +5400,7 @@ by a #." "#+end" ,(match-string 4) word-end - (zero-or-more any))))) + (zero-or-more nonl))))) ;; We look further than LIMIT on purpose. nil t) ;; We do have a matching #+end line. @@ -5473,7 +5473,7 @@ by a #." (beginning-of-line) (looking-at (rx (group (zero-or-more (any " \t")) "#+caption" - (optional "[" (zero-or-more any) "]") + (optional "[" (zero-or-more nonl) "]") ":") (zero-or-more (any " \t"))))) (add-text-properties (line-beginning-position) (match-end 1) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 38cb19f5a12..e6fcc684729 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -155,7 +155,7 @@ ,(rx bol (zero-or-more space) "(define-module" (one-or-more space) - (group "(" (one-or-more any) ")")) + (group "(" (one-or-more nonl) ")")) 1) ("Macros" ,(rx bol (zero-or-more space) "(" diff --git a/test/lisp/find-cmd-tests.el b/test/lisp/find-cmd-tests.el index a0b9a80ef47..3fbd0fc4ea3 100644 --- a/test/lisp/find-cmd-tests.el +++ b/test/lisp/find-cmd-tests.el @@ -25,7 +25,7 @@ (ert-deftest find-cmd-test-find-cmd () (should (string-match - (rx "find " (+ any) + (rx "find " (+ nonl) " \\( \\( -name .svn -or -name .git -or -name .CVS \\)" " -prune -or -true \\)" " \\( \\( \\(" " -name \\*.pl -or -name \\*.pm -or -name \\*.t \\)" From 6e255ddfffa90d975eec62749c9acd385336f252 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 30 May 2023 10:23:39 +0200 Subject: [PATCH 3/8] * test/lisp/dnd-tests.el (dnd-tests-begin-text-drag): Fix typo. --- test/lisp/dnd-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/lisp/dnd-tests.el b/test/lisp/dnd-tests.el index a603f29eb6d..9f97d739cec 100644 --- a/test/lisp/dnd-tests.el +++ b/test/lisp/dnd-tests.el @@ -172,7 +172,7 @@ This function only tries to handle strings." (extracted-1 (dnd-tests-extract-selection-data string-data-1 t)) (extracted (dnd-tests-extract-selection-data string-data t))) (should (and (stringp extracted) (stringp extracted-1))) - (should (equal extracted extracted))) + (should (equal extracted extracted-1))) ;; Now check text/plain. (let ((string-data (dnd-tests-verify-selection-data 'text/plain))) From 9ae212fb1e5ef8cffd10ee174004caabf2027ba3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 30 May 2023 10:38:06 +0200 Subject: [PATCH 4/8] xml.el: remove incorrect and botched attribute whitespace collapse * lisp/xml.el (xml-parse-attlist): Don't attempt to collapse multiple consecutive whitespace characters into a single space, which is wrong to do a this point when attributes must be assumed to be CDATA. The code was actually unintentionally correct since it forgot to use the return value of `replace-regexp-in-string` (bug#63740). --- lisp/xml.el | 3 --- 1 file changed, 3 deletions(-) diff --git a/lisp/xml.el b/lisp/xml.el index 58d17a4b340..9095653416e 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -669,10 +669,7 @@ Leave point at the first non-blank character after the tag." (if (assoc name attlist) (error "XML: (Not Well-Formed) Each attribute must be unique within an element")) - ;; Multiple whitespace characters should be replaced with a single one - ;; in the attributes (let ((string (match-string-no-properties 1))) - (replace-regexp-in-string "\\s-\\{2,\\}" " " string) (let ((expansion (xml-substitute-special string))) (unless (stringp expansion) ;; We say this is the constraint. It is actually that From 845f97d475b2b1f963ab078a11e0baf5388dd5b2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 30 May 2023 11:14:01 +0200 Subject: [PATCH 5/8] ; * admin/admin.el (cusver-scan): remove broken warning The call to `format-message` had no effect in itself, but it turns out that actually emitting the result just results in useless warnings so we remove it entirely. --- admin/admin.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/admin/admin.el b/admin/admin.el index 90f810b79c6..1f4c6986b0e 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -1038,8 +1038,7 @@ If optional argument OLD is non-nil, also scan for `defvar's." (and grp (setq grp (car (cdr-safe grp))) ; (quote foo) -> foo (setq ver (assq grp glist)))) - (setq alist (cons (cons var ver) alist)))) - (if form (format-message "Malformed defcustom: `%s'" form))))) + (setq alist (cons (cons var ver) alist))))))) (message "%sdone" m) alist)) From 27d68d790f7d600df0918eb9b95b1078fd6185f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 30 May 2023 11:17:10 +0200 Subject: [PATCH 6/8] ; * admin/cus-test.el (cus-test-apropos): remove TODO (already done) --- admin/cus-test.el | 2 -- 1 file changed, 2 deletions(-) diff --git a/admin/cus-test.el b/admin/cus-test.el index f07019bb52c..c833ddacd84 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -221,8 +221,6 @@ The detected problematic options are stored in `cus-test-errors'." ;; Check the values (mapc (lambda (value) - ;; TODO for booleans, check for values that can be - ;; evaluated and are not t or nil. Usually a bug. (unless (widget-apply conv :match value) (let ((err (list symbol :type-error value type))) (unless (member err cus-test-errors) From 49c56f333524b2caa34151e44c14ca0dee8d8942 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 30 May 2023 17:09:45 +0200 Subject: [PATCH 7/8] Add function declarations * lisp/emacs-lisp/byte-opt.el (side-effect-free-fns): Add get-byte, string-width, unibyte-string, special-variable-p, frexp, buffer-hash, buffer-line-statistics, load-average, md5, secure-hash, string-collate-equalp, string-collate-lessp, string-to-unibyte, string-version-lessp, current-cpu-time. (side-effect-and-error-free-fns): Add equal-including-properties. (pure-fns): Add equal-including-properties, string-version-lessp. * lisp/emacs-lisp/bytecomp.el (important-return-value-fns): Add match-data. * lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym) (frame-configuration-p, apply-partially, make-composed-keymap) (keymap-canonicalize, listify-key-sequence, event-modifiers) (event-basic-type, mouse-event-p, event-start, event-end) (event-click-count, event-line-count, posnp, posn-window, posn-area) (posn-point, posn-x-y, posn-col-row, posn-actual-col-row) (posn-timestamp, posn-string, posn-image, posn-object) (posn-object-x-y, posn-object-width-height, provided-mode-derived-p) (derived-mode-p, autoloadp, locate-eln-file, symbol-file) (process-lines-handling-status, process-lines) (process-lines-ignore-status, process-get) (copy-overlay, shell-quote-argument, field-at-pos): Add appropriate function declarations. --- lisp/emacs-lisp/byte-opt.el | 29 ++++++++++++++++++--------- lisp/emacs-lisp/bytecomp.el | 2 ++ lisp/subr.el | 40 +++++++++++++++++++++++++++++++++++++ 3 files changed, 62 insertions(+), 9 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 8fe5066c49e..562f21aa751 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1685,7 +1685,8 @@ See Info node `(elisp) Integer Basics'." category-docstring category-set-mnemonics char-category-set copy-category-table get-unused-category make-category-set ;; character.c - char-width multibyte-char-to-unibyte string unibyte-char-to-multibyte + char-width get-byte multibyte-char-to-unibyte string string-width + unibyte-char-to-multibyte unibyte-string ;; charset.c decode-char encode-char ;; chartab.c @@ -1715,6 +1716,8 @@ See Info node `(elisp) Integer Basics'." line-beginning-position line-end-position ngettext pos-bol pos-eol propertize region-beginning region-end string-to-char user-full-name user-login-name + ;; eval.c + special-variable-p ;; fileio.c car-less-than-car directory-name-p file-directory-p file-exists-p file-name-absolute-p file-name-concat file-newer-than-file-p @@ -1723,23 +1726,28 @@ See Info node `(elisp) Integer Basics'." file-locked-p ;; floatfns.c abs acos asin atan ceiling copysign cos exp expt fceiling ffloor - float floor fround ftruncate isnan ldexp log logb round sin sqrt tan + float floor frexp fround ftruncate isnan ldexp log logb round + sin sqrt tan truncate ;; fns.c append assq base64-decode-string base64-encode-string base64url-encode-string + buffer-hash buffer-line-statistics compare-strings concat copy-alist copy-hash-table copy-sequence elt featurep get gethash hash-table-count hash-table-rehash-size hash-table-rehash-threshold hash-table-size hash-table-test hash-table-weakness length length< length= length> - line-number-at-pos locale-info make-hash-table + line-number-at-pos load-average locale-info make-hash-table md5 member memq memql nth nthcdr - object-intervals rassoc rassq reverse - string-as-multibyte string-as-unibyte string-bytes string-distance + object-intervals rassoc rassq reverse secure-hash + string-as-multibyte string-as-unibyte string-bytes + string-collate-equalp string-collate-lessp string-distance string-equal string-lessp string-make-multibyte string-make-unibyte - string-search string-to-multibyte substring substring-no-properties + string-search string-to-multibyte string-to-unibyte + string-version-lessp + substring substring-no-properties sxhash-eq sxhash-eql sxhash-equal sxhash-equal-including-properties take vconcat ;; frame.c @@ -1799,6 +1807,7 @@ See Info node `(elisp) Integer Basics'." all-threads condition-mutex condition-name mutex-name thread-live-p thread-name ;; timefns.c + current-cpu-time current-time-string current-time-zone decode-time encode-time float-time format-time-string time-add time-convert time-equal-p time-less-p time-subtract @@ -1858,7 +1867,8 @@ See Info node `(elisp) Integer Basics'." ;; fileio.c default-file-modes ;; fns.c - eql equal hash-table-p identity proper-list-p safe-length + eql equal equal-including-properties + hash-table-p identity proper-list-p safe-length secure-hash-algorithms ;; frame.c frame-list frame-live-p framep last-nonminibuffer-frame @@ -1936,10 +1946,11 @@ See Info node `(elisp) Integer Basics'." isnan ldexp logb round sqrt truncate ;; fns.c assq base64-decode-string base64-encode-string base64url-encode-string - concat elt eql equal hash-table-p identity length length< length= + concat elt eql equal equal-including-properties + hash-table-p identity length length< length= length> member memq memql nth nthcdr proper-list-p rassoc rassq safe-length string-bytes string-distance string-equal string-lessp - string-search take + string-search string-version-lessp take ;; search.c regexp-quote ;; syntax.c diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index aea50fc8e57..b7ae45a0610 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3566,6 +3566,8 @@ lambda-expression." ;; when used on arrays, but most calls pass lists. nreverse sort + match-data + ;; Adding these functions causes many warnings; ;; evaluate how many of them are false first. delq delete diff --git a/lisp/subr.el b/lisp/subr.el index 95d3bc03544..cef631a69c3 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -205,6 +205,7 @@ buffer-local wherever it is set." (defun buffer-local-boundp (symbol buffer) "Return non-nil if SYMBOL is bound in BUFFER. Also see `local-variable-p'." + (declare (side-effect-free t)) (condition-case nil (buffer-local-value symbol buffer) (:success t) @@ -298,6 +299,7 @@ value of last one, or nil if there are none." (defsubst subr-primitive-p (object) "Return t if OBJECT is a built-in primitive function." + (declare (side-effect-free error-free)) (and (subrp object) (not (subr-native-elisp-p object)))) @@ -415,6 +417,7 @@ The CONDITION argument is not evaluated. Do not quote it." "Return a new uninterned symbol. The name is made by appending `gensym-counter' to PREFIX. PREFIX is a string, and defaults to \"g\"." + (declare (important-return-value t)) (let ((num (prog1 gensym-counter (setq gensym-counter (1+ gensym-counter))))) (make-symbol (format "%s%d" (or prefix "g") num)))) @@ -497,6 +500,7 @@ Defaults to `error'." "Return non-nil if OBJECT seems to be a frame configuration. Any list whose car is `frame-configuration' is assumed to be a frame configuration." + (declare (pure t) (side-effect-free error-free)) (and (consp object) (eq (car object) 'frame-configuration))) @@ -506,6 +510,7 @@ ARGS is a list of the first N arguments to pass to FUN. The result is a new function which does the same as FUN, except that the first N arguments are fixed at the values with which this function was called." + (declare (side-effect-free error-free)) (lambda (&rest args2) (apply fun (append args args2)))) @@ -1076,6 +1081,7 @@ any corresponding binding in PARENT, but it does not override corresponding bindings in other keymaps of MAPS. MAPS can be a list of keymaps or a single keymap. PARENT if non-nil should be a keymap." + (declare (side-effect-free t)) `(keymap ,@(if (keymapp maps) (list maps) maps) ,@parent)) @@ -1216,6 +1222,7 @@ This resolves inheritance and redefinitions. The returned keymap should behave identically to a copy of KEYMAP w.r.t `lookup-key' and use in active keymaps and menus. Subkeymaps may be modified but are not canonicalized." + (declare (important-return-value t)) ;; FIXME: Problem with the difference between a nil binding ;; that hides a binding in an inherited map and a nil binding that's ignored ;; to let some further binding visible. Currently a nil binding hides all. @@ -1538,6 +1545,7 @@ See also `current-global-map'.") (defun listify-key-sequence (key) "Convert a key sequence to a list of events." + (declare (side-effect-free t)) (if (vectorp key) (append key nil) (mapcar (lambda (c) @@ -1565,6 +1573,7 @@ EVENT may be an event or an event type. If EVENT is a symbol that has never been used in an event that has been read as input in the current Emacs session, then this function may fail to include the `click' modifier." + (declare (side-effect-free t)) (unless (stringp event) (let ((type event)) (if (listp type) @@ -1598,6 +1607,7 @@ The value is a printing character (not upper case) or a symbol. EVENT may be an event or an event type. If EVENT is a symbol that has never been used in an event that has been read as input in the current Emacs session, then this function may return nil." + (declare (side-effect-free t)) (unless (stringp event) (if (consp event) (setq event (car event))) @@ -1618,6 +1628,7 @@ in the current Emacs session, then this function may return nil." (defun mouse-event-p (object) "Return non-nil if OBJECT is a mouse click event." + (declare (side-effect-free t)) ;; is this really correct? maybe remove mouse-movement? (memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement))) @@ -1663,6 +1674,7 @@ nil or (STRING . POSITION)'. `posn-timestamp': The time the event occurred, in milliseconds. For more information, see Info node `(elisp)Click Events'." + (declare (side-effect-free t)) (or (and (consp event) (nth 1 event)) (event--posn-at-point))) @@ -1671,17 +1683,20 @@ For more information, see Info node `(elisp)Click Events'." EVENT should be a click, drag, or key press event. See `event-start' for a description of the value returned." + (declare (side-effect-free t)) (or (and (consp event) (nth (if (consp (nth 2 event)) 2 1) event)) (event--posn-at-point))) (defsubst event-click-count (event) "Return the multi-click count of EVENT, a click or drag event. The return value is a positive integer." + (declare (side-effect-free t)) (if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1)) (defsubst event-line-count (event) "Return the line count of EVENT, a mousewheel event. The return value is a positive integer." + (declare (side-effect-free t)) (if (and (consp event) (integerp (nth 3 event))) (nth 3 event) 1)) ;;;; Extracting fields of the positions in an event. @@ -1691,6 +1706,7 @@ The return value is a positive integer." A `posn' object is returned from functions such as `event-start'. If OBJ is a valid `posn' object, but specifies a frame rather than a window, return nil." + (declare (side-effect-free error-free)) ;; FIXME: Correct the behavior of this function so that all valid ;; `posn' objects are recognized, after updating other code that ;; depends on its present behavior. @@ -1704,12 +1720,14 @@ than a window, return nil." If POSITION is outside the frame where the event was initiated, return that frame instead. POSITION should be a list of the form returned by the `event-start' and `event-end' functions." + (declare (side-effect-free t)) (nth 0 position)) (defsubst posn-area (position) "Return the window area recorded in POSITION, or nil for the text area. POSITION should be a list of the form returned by the `event-start' and `event-end' functions." + (declare (side-effect-free t)) (let ((area (if (consp (nth 1 position)) (car (nth 1 position)) (nth 1 position)))) @@ -1721,6 +1739,7 @@ POSITION should be a list of the form returned by the `event-start' and `event-end' functions. Returns nil if POSITION does not correspond to any buffer location (e.g. a click on a scroll bar)." + (declare (side-effect-free t)) (or (nth 5 position) (let ((pt (nth 1 position))) (or (car-safe pt) @@ -1746,6 +1765,7 @@ Select the corresponding window as well." The return value has the form (X . Y), where X and Y are given in pixels. POSITION should be a list of the form returned by `event-start' and `event-end'." + (declare (side-effect-free t)) (nth 2 position)) (declare-function scroll-bar-scale "scroll-bar" (num-denom whole)) @@ -1765,6 +1785,7 @@ corresponds to the vertical position of the click in the scroll bar. POSITION should be a list of the form returned by the `event-start' and `event-end' functions." + (declare (side-effect-free t)) (let* ((pair (posn-x-y position)) (frame-or-window (posn-window position)) (frame (if (framep frame-or-window) @@ -1810,12 +1831,14 @@ This function does not account for the width on display, like the number of visual columns taken by a TAB or image. If you need the coordinates of POSITION in character units, you should use `posn-col-row', not this function." + (declare (side-effect-free t)) (nth 6 position)) (defsubst posn-timestamp (position) "Return the timestamp of POSITION. POSITION should be a list of the form returned by the `event-start' and `event-end' functions." + (declare (side-effect-free t)) (nth 3 position)) (defun posn-string (position) @@ -1823,6 +1846,7 @@ and `event-end' functions." Value is a cons (STRING . STRING-POS), or nil if not a string. POSITION should be a list of the form returned by the `event-start' and `event-end' functions." + (declare (side-effect-free t)) (let ((x (nth 4 position))) ;; Apparently this can also be `handle' or `below-handle' (bug#13979). (when (consp x) x))) @@ -1832,6 +1856,7 @@ and `event-end' functions." Value is a list (image ...), or nil if not an image. POSITION should be a list of the form returned by the `event-start' and `event-end' functions." + (declare (side-effect-free t)) (nth 7 position)) (defsubst posn-object (position) @@ -1840,6 +1865,7 @@ Value is a list (image ...) for an image object, a cons cell \(STRING . STRING-POS) for a string object, and nil for a buffer position. POSITION should be a list of the form returned by the `event-start' and `event-end' functions." + (declare (side-effect-free t)) (or (posn-image position) (posn-string position))) (defsubst posn-object-x-y (position) @@ -1848,12 +1874,14 @@ The return value has the form (DX . DY), where DX and DY are given in pixels, and they are relative to the top-left corner of the clicked glyph of object at POSITION. POSITION should be a list of the form returned by `event-start' and `event-end'." + (declare (side-effect-free t)) (nth 8 position)) (defsubst posn-object-width-height (position) "Return the pixel width and height of the object of POSITION. The return value has the form (WIDTH . HEIGHT). POSITION should be a list of the form returned by `event-start' and `event-end'." + (declare (side-effect-free t)) (nth 9 position)) (defun values--store-value (value) @@ -2614,6 +2642,7 @@ The variable list SPEC is the same as in `if-let*'." Uses the `derived-mode-parent' property of the symbol to trace backwards. If you just want to check `major-mode', use `derived-mode-p'." ;; If MODE is an alias, then look up the real mode function first. + (declare (side-effect-free t)) (when-let ((alias (symbol-function mode))) (when (symbolp alias) (setq mode alias))) @@ -2628,6 +2657,7 @@ If you just want to check `major-mode', use `derived-mode-p'." (defun derived-mode-p (&rest modes) "Non-nil if the current major mode is derived from one of MODES. Uses the `derived-mode-parent' property of the symbol to trace backwards." + (declare (side-effect-free t)) (apply #'provided-mode-derived-p major-mode modes)) (defvar-local major-mode--suspended nil) @@ -2751,6 +2781,7 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label." (defsubst autoloadp (object) "Non-nil if OBJECT is an autoload." + (declare (side-effect-free error-free)) (eq 'autoload (car-safe object))) ;; (defun autoload-type (object) @@ -2795,6 +2826,7 @@ This is to `put' what `defalias' is to `fset'." (defun locate-eln-file (eln-file) "Locate a natively-compiled ELN-FILE by searching its load path. This function looks in directories named by `native-comp-eln-load-path'." + (declare (important-return-value t)) (or (locate-file-internal (concat comp-native-version-dir "/" eln-file) native-comp-eln-load-path) (locate-file-internal @@ -2826,6 +2858,7 @@ instead. This function only works for symbols defined in Lisp files. For symbols that are defined in C files, use `help-C-file-name' instead." + (declare (important-return-value t)) (if (and (or (null type) (eq type 'defun)) (symbolp symbol) (autoloadp (symbol-function symbol))) @@ -2952,6 +2985,7 @@ argument, which will be called with the exit status of the program before the output is collected. If STATUS-HANDLER is nil, an error is signaled if the program returns with a non-zero exit status." + (declare (important-return-value t)) (with-temp-buffer (let ((status (apply #'call-process program nil (current-buffer) nil args))) (if status-handler @@ -2972,12 +3006,14 @@ exit status." "Execute PROGRAM with ARGS, returning its output as a list of lines. Signal an error if the program returns with a non-zero exit status. Also see `process-lines-ignore-status'." + (declare (important-return-value t)) (apply #'process-lines-handling-status program nil args)) (defun process-lines-ignore-status (program &rest args) "Execute PROGRAM with ARGS, returning its output as a list of lines. The exit status of the program is ignored. Also see `process-lines'." + (declare (important-return-value t)) (apply #'process-lines-handling-status program #'ignore args)) (defun process-live-p (process) @@ -3006,6 +3042,7 @@ process." (defun process-get (process propname) "Return the value of PROCESS' PROPNAME property. This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'." + (declare (side-effect-free t)) (plist-get (process-plist process) propname)) (defun process-put (process propname value) @@ -3924,6 +3961,7 @@ If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there." (defun copy-overlay (o) "Return a copy of overlay O." + (declare (important-return-value t)) (let ((o1 (if (overlay-buffer o) (make-overlay (overlay-start o) (overlay-end o) ;; FIXME: there's no easy way to find the @@ -4133,6 +4171,7 @@ See Info node `(elisp)Security Considerations'. If the optional POSIX argument is non-nil, ARGUMENT is quoted according to POSIX shell quoting rules, regardless of the system's shell." + (declare (important-return-value t)) (cond ((and (not posix) (eq system-type 'ms-dos)) ;; Quote using double quotes, but escape any existing quotes in @@ -4250,6 +4289,7 @@ or byte-code." (defun field-at-pos (pos) "Return the field at position POS, taking stickiness etc into account." + (declare (important-return-value t)) (let ((raw-field (get-char-property (field-beginning pos) 'field))) (if (eq raw-field 'boundary) (get-char-property (1- (field-end pos)) 'field) From ecc1d990d9e9d006838ca514213ea5e46a459363 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 19 May 2023 10:46:41 +0200 Subject: [PATCH 8/8] 'describe-function' shows function inferred type when available * lisp/help-fns.el (help-fns--signature): Print function type for native compiled code. * etc/NEWS: Add entry. --- etc/NEWS | 5 +++++ lisp/help-fns.el | 6 +++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index f5e15175016..80e997d420f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -30,6 +30,11 @@ applies, and please also update docstrings as needed. * Changes in Emacs 30.1 +** Help +** 'describe-function' shows function inferred type when available. +For native compiled Lisp functions 'describe-function' prints (after +the signature) the automatically inferred function type as well. + --- ** New user option 'describe-bindings-outline-rules'. This user option controls outline visibility in the output buffer of diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 1966193d1a7..c4e09e48bea 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -710,7 +710,11 @@ the C sources, too." (high-doc (cdr high))) (unless (and (symbolp function) (get function 'reader-construct)) - (insert high-usage "\n")) + (insert high-usage "\n") + (when (and (featurep 'native-compile) + (subr-native-elisp-p (symbol-function function)) + (subr-type (symbol-function function))) + (insert (format "\nInferred type: %s\n" (subr-type (symbol-function function)))))) (fill-region fill-begin (point)) high-doc)))))