commit 4078d0fd3ee9e55c3da219aa6e7788ac6130697b (HEAD, refs/remotes/origin/master) Author: Juri Linkov Date: Fri May 3 09:22:39 2024 +0300 * doc/lispref/keymaps.texi (Creating Keymaps): Add :repeat :hints (bug#70576). diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 1521b3815f4..32aa98d31cb 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -480,7 +480,7 @@ following values are available: This means all the commands in the keymap are repeatable, and is the most common usage. -@item (:enter (commands ...) :exit (commands ...)) +@item (:enter (commands ...) :exit (commands ...) :hints ((command . "hint") ...)) This specifies that the commands in the @code{:enter} list enter @code{repeat-mode}, and the commands in the @code{:exit} list exit repeat mode. @@ -494,6 +494,10 @@ If the @code{:exit} list is empty then no commands in the map exit @code{repeat-mode}. Specifying one or more commands in this list is useful if the keymap being defined contains a command that should not have the @code{repeat-map} property. + +The @code{:hints} list can contain cons pairs where the @sc{car} is +a command and the @sc{cdr} is a string that is displayed alongside of +the repeatable key in the echo area. @end table In order to make e.g.@: @kbd{u} repeat the @code{undo} command, the commit dc77164104451293ccc32b687090370c70df4481 Author: Elias G. Perez Date: Thu May 2 10:33:43 2024 -0600 Fix bug#70711 * lisp/progmodes/flymake.el (flymake--indicator-overlay-spec): Check if `flymake-fringe-indicator-position' or `flymake-margin-indicator-position' are non-nil for allow no indicators. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index f5bf68db574..2e602658ea7 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -754,13 +754,15 @@ associated `flymake-category' return DEFAULT." (indicator-cdr (if (listp value) (cdr value)))) (cond - ((symbolp indicator-car) + ((and (symbolp indicator-car) + flymake-fringe-indicator-position) (propertize "!" 'display (cons flymake-fringe-indicator-position (if (listp value) value (list value))))) - ((stringp indicator-car) + ((and (stringp indicator-car) + flymake-margin-indicator-position) (propertize "!" 'display `((margin ,flymake-margin-indicator-position) commit a2ccda71c15f75edef0711f94351af0dd7241beb Author: Lin Sun Date: Sat Apr 27 06:55:49 2024 +0000 Only run 'eshell-first-time-mode-hook' once per Emacs session * lisp/eshell/esh-mode.el (eshell-mode): Set 'eshell-first-time-p' to nil (bug#70610). diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index b15f99a0359..5de200ce4b5 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -418,8 +418,10 @@ and the hook `eshell-exit-hook'." (add-hook 'kill-buffer-hook #'eshell-kill-buffer-function t t) - (if eshell-first-time-p - (run-hooks 'eshell-first-time-mode-hook)) + (when eshell-first-time-p + (setq eshell-first-time-p nil) + (run-hooks 'eshell-first-time-mode-hook)) + (run-hooks 'eshell-post-command-hook)) (put 'eshell-mode 'mode-class 'special) commit 6171a9a628fb71b172598c7d7bbea8448ee251d6 Author: Po Lu Date: Fri May 3 10:43:31 2024 +0800 Prevent reporting of crashes when Emacs is restarted on Android * src/emacs.c (Fkill_emacs): Ignore SIGBUS and SIGSGEV immediately before calling exit. diff --git a/src/emacs.c b/src/emacs.c index 1cb1e70ac65..7431cef274d 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2999,6 +2999,21 @@ killed. */ #ifdef HAVE_NATIVE_COMP eln_load_path_final_clean_up (); #endif +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + if (android_init_gui) + { + /* Calls to exit may be followed by illegal accesses from + toolkit-managed threads as the thread group is destroyed, which + are inconsequential when the process is being terminated, but + which must be suppressed to inhibit reporting of superfluous + crashes by the system. + + Execution won't return to Emacs whatever the value of RESTART, + as `android_restart_emacs' will only ever abort or succeed. */ + signal (SIGBUS, SIG_IGN); + signal (SIGSEGV, SIG_IGN); + } +#endif /* HAVE_ANDROID && !ANDROID_STUBIFY */ if (!NILP (restart)) { commit 068e44ed754344667cf42fe252ebb601d7a8db93 Author: F. Jason Park Date: Thu Apr 25 05:09:50 2024 -0700 ; Set explicit hook depth for erc-once-with-server-event * lisp/erc/erc.el (erc-once-with-server-event): Set hook depth to -95. * test/lisp/erc/erc-scenarios-base-association-nick.el: Improve comment. * test/lisp/erc/resources/erc-d/erc-d-tests.el (erc-d--render-entries): Remove do-nothing assertion since its purpose was unclear and likely dubious, as was incidentally highlighted by the addition of a function not present on older Emacsen, which this test still needs to run on. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 053d44d5362..e37b28669a4 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1595,7 +1595,7 @@ capabilities." (remove-hook hook fun t)) (fmakunbound fun) (funcall f proc parsed))) - (add-hook hook fun nil t) + (add-hook hook fun -95 t) fun)) (defun erc--warn-once-before-connect (mode-var &rest args) diff --git a/test/lisp/erc/erc-scenarios-base-association-nick.el b/test/lisp/erc/erc-scenarios-base-association-nick.el index 57e8abda73c..c4601f3771f 100644 --- a/test/lisp/erc/erc-scenarios-base-association-nick.el +++ b/test/lisp/erc/erc-scenarios-base-association-nick.el @@ -28,22 +28,22 @@ ;; You register a new nick in a dedicated query buffer, disconnect, ;; and log back in, but your nick is not granted (maybe you just -;; turned off SASL). In any case, ERC obtains a backtick'd version. +;; turned off SASL). In any case, ERC obtains a backticked version. ;; You open a query buffer for NickServ, and ERC gives you the ;; existing one. And after you identify, all buffers retain their ;; names, although your net ID has changed internally. ;; -;; If ERC would've instead failed (or intentionally refused) to make -;; the association, you would've ended up with a new NickServ buffer -;; named after the new net ID as a suffix (based on the backtick'd -;; nick), for example, NickServ@foonet/tester`. And the original -;; (disconnected) NickServ buffer would've gotten suffixed with *its* -;; net-ID as well, e.g., NickServ@foonet/tester. And after -;; identifying, you would've seen ERC merge the two as well as their -;; server buffers. While this alternate behavior may arguably be a -;; more honest reflection of reality, it's also quite inconvenient. -;; For a clearer example, see the original version of this file -;; introduced by "Add user-oriented test scenarios for ERC". +;; If ERC had instead failed (or intentionally refused) to make the +;; association, you would find yourself with a new NickServ buffer +;; named with a suffix reflecting the new net ID (based on the +;; backticked nick), for example, NickServ@foonet/tester`. And the +;; original (disconnected) NickServ buffer would also receive a suffix +;; with *its* net-ID, e.g., NickServ@foonet/tester. Upon identifying +;; yourself, you'd see ERC merge both buffers along with their server +;; buffers. While this alternate behavior might more accurately +;; reflect reality, it introduces significant inconvenience. For a +;; clearer example, see the original version of this file introduced +;; by "Add user-oriented test scenarios for ERC". (ert-deftest erc-scenarios-base-association-nick-bumped () :tags '(:expensive-test) diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el b/test/lisp/erc/resources/erc-d/erc-d-tests.el index dda1b1ced84..a6357c90f03 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-tests.el +++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el @@ -367,9 +367,6 @@ (should (equal (funcall it) "foo3foo"))) (ert-info ("Exits clean") - (when (interpreted-function-p - (alist-get 'f (erc-d-dialog-vars dialog))) ; may be compiled - (should (aref (alist-get 'f (erc-d-dialog-vars dialog)) 2))) (should-not (funcall it)) (should (equal (erc-d-dialog-vars dialog) `((:a . 1) commit a156c98df0f24da365872678e20e84e1157d1225 Author: Mattias EngdegÄrd Date: Thu May 2 21:49:40 2024 +0200 Eliminate string data mutation in ruler-mode * lisp/ruler-mode.el (ruler-mode-ruler): Mutate a vector instead of a string. diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index bce6a1805bc..b9c32a40a07 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -667,27 +667,24 @@ Optional argument PROPS specifies other text properties to apply." (sbvt (car (window-current-scroll-bars))) ;; Create an "clean" ruler. (ruler - (propertize - ;; Make the part of header-line corresponding to the - ;; line-number display be blank, not filled with - ;; ruler-mode-basic-graduation-char. - (if display-line-numbers - (let* ((lndw (round (line-number-display-width 'columns))) - ;; We need a multibyte string here so we could - ;; later use aset to insert multibyte characters - ;; into that string. - (s (make-string lndw ?\s t))) - (concat s (make-string (- w lndw) - ruler-mode-basic-graduation-char t))) - (make-string w ruler-mode-basic-graduation-char t)) - 'face 'ruler-mode-default - 'local-map ruler-mode-map - 'help-echo (cond - (ruler-mode-show-tab-stops - ruler-mode-ruler-help-echo-when-tab-stops) - (goal-column - ruler-mode-ruler-help-echo-when-goal-column) - (ruler-mode-ruler-help-echo)))) + ;; Make the part of header-line corresponding to the + ;; line-number display be blank, not filled with + ;; ruler-mode-basic-graduation-char. + (if display-line-numbers + (let ((lndw (round (line-number-display-width 'columns)))) + (vconcat (make-vector lndw ?\s) + (make-vector (- w lndw) + ruler-mode-basic-graduation-char))) + (make-vector w ruler-mode-basic-graduation-char))) + (ruler-wide-props + `((face . ruler-mode-default) + (local-map . ruler-mode-map) + (help-echo . ,(cond (ruler-mode-show-tab-stops + ruler-mode-ruler-help-echo-when-tab-stops) + (goal-column + ruler-mode-ruler-help-echo-when-goal-column) + (ruler-mode-ruler-help-echo))))) + (props nil) k c) ;; Setup the active area. (while (< i w) @@ -698,9 +695,7 @@ Optional argument PROPS specifies other text properties to apply." (setq c (number-to-string (/ j 10)) m (length c) k i) - (put-text-property - i (1+ i) 'face 'ruler-mode-column-number - ruler) + (push (list i (1+ i) 'face 'ruler-mode-column-number) props) (while (and (> m 0) (>= k 0)) (aset ruler k (aref c (setq m (1- m)))) (setq k (1- k)))) @@ -712,62 +707,53 @@ Optional argument PROPS specifies other text properties to apply." ;; Show the `current-column' marker. ((= j (current-column)) (aset ruler i ruler-mode-current-column-char) - (put-text-property - i (1+ i) 'face 'ruler-mode-current-column - ruler)) + (push (list i (1+ i) 'face 'ruler-mode-current-column) props)) ;; Show the `goal-column' marker. ((and goal-column (= j goal-column)) (aset ruler i ruler-mode-goal-column-char) - (put-text-property - i (1+ i) 'face 'ruler-mode-goal-column - ruler) - (put-text-property - i (1+ i) 'mouse-face 'mode-line-highlight - ruler) - (put-text-property - i (1+ i) 'help-echo ruler-mode-goal-column-help-echo - ruler)) + (push (list i (1+ i) 'face 'ruler-mode-goal-column) props) + (push (list i (1+ i) 'mouse-face 'mode-line-highlight) props) + (push (list i (1+ i) 'help-echo ruler-mode-goal-column-help-echo) + props)) ;; Show the `comment-column' marker. ((= j comment-column) (aset ruler i ruler-mode-comment-column-char) - (put-text-property - i (1+ i) 'face 'ruler-mode-comment-column - ruler) - (put-text-property - i (1+ i) 'mouse-face 'mode-line-highlight - ruler) - (put-text-property - i (1+ i) 'help-echo ruler-mode-comment-column-help-echo - ruler)) + (push (list i (1+ i) 'face 'ruler-mode-comment-column) + props) + (push (list i (1+ i) 'mouse-face 'mode-line-highlight) + props) + (push (list i (1+ i) 'help-echo ruler-mode-comment-column-help-echo) + props)) ;; Show the `fill-column' marker. ((= j fill-column) (aset ruler i ruler-mode-fill-column-char) - (put-text-property - i (1+ i) 'face 'ruler-mode-fill-column - ruler) - (put-text-property - i (1+ i) 'mouse-face 'mode-line-highlight - ruler) - (put-text-property - i (1+ i) 'help-echo ruler-mode-fill-column-help-echo - ruler)) + (push (list i (1+ i) 'face 'ruler-mode-fill-column) props) + (push (list i (1+ i) 'mouse-face 'mode-line-highlight) props) + (push (list i (1+ i) 'help-echo ruler-mode-fill-column-help-echo) + props)) ;; Show the `tab-stop-list' markers. ((and ruler-mode-show-tab-stops (= j (indent-next-tab-stop (1- j)))) (aset ruler i ruler-mode-tab-stop-char) - (put-text-property - i (1+ i) 'face 'ruler-mode-tab-stop - ruler))) + (push (list i (1+ i) 'face 'ruler-mode-tab-stop) props))) (setq i (1+ i) j (1+ j))) - ;; Return the ruler propertized string. Using list here, - ;; instead of concat visually separate the different areas. - (if (nth 2 (window-fringes)) - ;; fringes outside margins. - (list "" (and (eq 'left sbvt) sb) lf lm - ruler rm rf (and (eq 'right sbvt) sb)) - ;; fringes inside margins. - (list "" (and (eq 'left sbvt) sb) lm lf - ruler rf rm (and (eq 'right sbvt) sb))))) + + (let ((ruler-str (concat ruler)) + (len (length ruler))) + (dolist (c ruler-wide-props) + (put-text-property 0 len (car c) (cdr c) ruler-str)) + (dolist (p (nreverse props)) + (put-text-property (nth 0 p) (nth 1 p) (nth 2 p) (nth 3 p) ruler-str)) + + ;; Return the ruler propertized string. Using list here, + ;; instead of concat visually separate the different areas. + (if (nth 2 (window-fringes)) + ;; fringes outside margins. + (list "" (and (eq 'left sbvt) sb) lf lm + ruler-str rm rf (and (eq 'right sbvt) sb)) + ;; fringes inside margins. + (list "" (and (eq 'left sbvt) sb) lm lf + ruler-str rf rm (and (eq 'right sbvt) sb)))))) (provide 'ruler-mode) commit 14cd4fce4b723a7f06cd7d8dba60c730670191d0 Author: Juri Linkov Date: Thu May 2 20:55:03 2024 +0300 * lisp/tab-bar.el: Support mouse clicks bound in keymap properties. (tab-bar--event-to-item): Handle mouse bindings for commands bound in keymap properties of global-mode-string (bug#70086). (tab-bar-mouse-down-1, tab-bar-mouse-1, tab-bar-touchscreen-begin): Add the symbol 'global' to the list of handled items. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 2a4f8fd6916..2e3d9a6b4ac 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -298,9 +298,13 @@ It returns a list of the form (KEY KEY-BINDING CLOSE-P), where: nil otherwise." (setq tab-bar--dragging-in-progress nil) (if (posn-window posn) - (let ((caption (car (posn-string posn)))) - (when caption - (get-text-property 0 'menu-item caption))) + (let* ((caption (car (posn-string posn))) + (menu-item (when caption + (get-text-property 0 'menu-item caption)))) + (when (equal menu-item '(global ignore nil)) + (setf (nth 1 menu-item) + (key-binding (vector 'tab-bar last-nonmenu-event) t))) + menu-item) ;; Text-mode emulation of switching tabs on the tab bar. ;; This code is used when you click the mouse in the tab bar ;; on a console which has no window system but does have a mouse. @@ -332,7 +336,7 @@ existing tab." (setq tab-bar--dragging-in-progress t) ;; Don't close the tab when clicked on the close button. Also ;; don't add new tab on down-mouse. Let `tab-bar-mouse-1' do this. - (unless (or (memq (car item) '(add-tab history-back history-forward)) + (unless (or (memq (car item) '(add-tab history-back history-forward global)) (nth 2 item)) (if (functionp (nth 1 item)) (call-interactively (nth 1 item)) @@ -347,7 +351,7 @@ regardless of where you click on it. Also add a new tab." (let* ((item (tab-bar--event-to-item (event-start event))) (tab-number (tab-bar--key-to-number (nth 0 item)))) (cond - ((and (memq (car item) '(add-tab history-back history-forward)) + ((and (memq (car item) '(add-tab history-back history-forward global)) (functionp (nth 1 item))) (call-interactively (nth 1 item))) ((and (nth 2 item) (not (eq tab-number t))) @@ -468,8 +472,8 @@ appropriate." (tab-bar-select-tab number)))) ;; Cancel the timer. (cancel-timer timer))) - ((and (memq (car item) '(add-tab history-back - history-forward)) + ((and (memq (car item) '( add-tab history-back + history-forward global)) (functionp (cadr item))) ;; This is some kind of button. Wait for the ;; tap to complete and press it. commit a914667a0071e3a19846fff9ea5ff8e8f1457e17 Author: Juri Linkov Date: Thu May 2 20:44:04 2024 +0300 Make the buffer displayed by tab-bar-select-restore-windows internal * lisp/tab-bar.el (tab-bar-select-restore-windows): Make the buffer " *Old buffer %s*" internal with the leading space in its name. diff --git a/etc/NEWS b/etc/NEWS index b55ee02e0bd..e2588afeb40 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -352,9 +352,9 @@ points after switching back to that tab. --- *** New user option 'tab-bar-select-restore-windows'. It defines what to do with windows whose buffer was killed since the tab -was last selected. By default it displays a placeholder buffer that -provides information about the name of the killed buffer that was -displayed in that window. +was last selected. By default it displays a placeholder buffer +with the name " *Old buffer *" that provides information about +the name of the killed buffer that was displayed in that window. --- *** New user option 'tab-bar-tab-name-format-functions'. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index cd076664faf..2a4f8fd6916 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1440,11 +1440,10 @@ if it was visiting a file." (buffer-file-name old-buffer))) (name (or file (and (bufferp old-buffer) - (fboundp 'buffer-last-name) (buffer-last-name old-buffer)) old-buffer)) (new-buffer (generate-new-buffer - (format "*Old buffer %s*" name)))) + (format " *Old buffer %s*" name)))) (with-current-buffer new-buffer (set-auto-mode) (insert (format-message "This window displayed the %s `%s'.\n" @@ -1511,7 +1510,7 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar." (when (and read-minibuffer-restore-windows minibuffer-was-active (not tab-bar-minibuffer-restore-tab)) (setq-local tab-bar-minibuffer-restore-tab (1+ from-index)) - (add-hook 'minibuffer-exit-hook 'tab-bar-minibuffer-restore-tab nil t)) + (add-hook 'minibuffer-exit-hook #'tab-bar-minibuffer-restore-tab nil t)) (unless (eq from-index to-index) (let* ((from-tab (tab-bar--tab)) commit 12e3ffcc97af739f0134959ce4a5ff2f23ffa971 Author: Eli Zaretskii Date: Thu May 2 19:30:40 2024 +0300 ; Fix last change * etc/NEWS: Fix wording of a recently-added item. * doc/lispref/functions.texi (Declare Form): Fix markup. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index d88f5d05339..a77bf6e233d 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2725,22 +2725,22 @@ Here's an example of using @code{type} inside @code{declare} to declare a function @code{positive-p} that takes an argument of type @var{number} and return a @var{boolean}: -@group @lisp +@group (defun positive-p (x) (declare (type (function (number) boolean))) (when (> x 0) t)) -@end lisp @end group +@end lisp Similarly this declares a function @code{cons-or-number} that: expects a first argument being a @var{cons} or a @var{number}, a second optional argument of type @var{string} and return one of the symbols @code{is-cons} or @code{is-number}: -@group @lisp +@group (defun cons-or-number (x &optional err-msg) (declare (type (function ((or cons number) &optional string) (member is-cons is-number)))) @@ -2749,11 +2749,10 @@ argument of type @var{string} and return one of the symbols (if (numberp x) 'is-number (error (or err-msg "Unexpected input"))))) -@end lisp @end group +@end lisp -More types are described in the Lisp Data Types chapter (@ref{Lisp Data -Types}). +For description of additional types, see @ref{Lisp Data Types}). Declaring a function with an incorrect type produces undefined behavior and could lead to unexpected results or might even crash Emacs when code diff --git a/etc/NEWS b/etc/NEWS index 8477a1eed58..b55ee02e0bd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1940,9 +1940,9 @@ unibyte string. * Lisp Changes in Emacs 30.1 +++ -** Function type declaration -It is now possible, using the 'declare' macro, to declare expected types -of function arguments and return type. +** Function type declaration. +It is now possible to declare the expected type of a function's +arguments and its return type using the 'declare' macro. ** New types 'closure' and 'interpreted-function'. 'interpreted-function' is the new type used for interpreted functions, commit da8b06bd6181bc56fb0f133d17cae7eff44a83e8 Merge: 2f5c9b31161 64d3100cb59 Author: Andrea Corallo Date: Thu May 2 17:06:07 2024 +0200 Merge branch 'lisp-func-type-decls' into 'master' commit 64d3100cb5973f2e8372d29f7658c32a63e191e2 Author: Andrea Corallo Date: Thu May 2 16:42:45 2024 +0200 etc/NEWS (Function type declaration): Mark it +++. diff --git a/etc/NEWS b/etc/NEWS index 73dbe3b2b83..f6da27a794d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1935,6 +1935,7 @@ unibyte string. * Lisp Changes in Emacs 30.1 ++++ ** Function type declaration It is now possible, using the 'declare' macro, to declare expected types of function arguments and return type. commit 02690d95f9e47163ecca9b26a01270215727cd69 Author: Andrea Corallo Date: Thu May 2 16:38:14 2024 +0200 * doc/lispref/functions.texi (Declare Form): Improve again declare type. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 3aa4fc9a457..d88f5d05339 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2712,31 +2712,34 @@ instead of native code for the function. @item (type @var{type}) Declare @var{type} to be the type of this function. This is used for documentation by @code{describe-function}. Also it can be used by the -native compiler (@pxref{Native-Compilation}) for improving code +native compiler (@pxref{Native Compilation}) for improving code generation and for deriving more precisely the type of other functions without type declaration. -@var{type} is a type specifier in the form @code{(function (ARG-1-TYPE -... ARG-N-TYPE) RETURN-TYPE)}. Argument types can be interleaved with -symbols @code{&optional} and @code{&rest} to match the @pxref{Argument -List} of the function. +@var{type} is a type specifier in the form @w{@code{(function +(ARG-1-TYPE ... ARG-N-TYPE) RETURN-TYPE)}}. Argument types can be +interleaved with symbols @code{&optional} and @code{&rest} to match the +function's arguments (@pxref{Argument List}). Here's an example of using @code{type} inside @code{declare} to declare a function @code{positive-p} that takes an argument of type @var{number} and return a @var{boolean}: +@group @lisp (defun positive-p (x) (declare (type (function (number) boolean))) (when (> x 0) t)) @end lisp +@end group Similarly this declares a function @code{cons-or-number} that: expects a first argument being a @var{cons} or a @var{number}, a second optional argument of type @var{string} and return one of the symbols @code{is-cons} or @code{is-number}: +@group @lisp (defun cons-or-number (x &optional err-msg) (declare (type (function ((or cons number) &optional string) @@ -2747,14 +2750,16 @@ argument of type @var{string} and return one of the symbols 'is-number (error (or err-msg "Unexpected input"))))) @end lisp +@end group -More types are described in @pxref{Lisp Data Types}. +More types are described in the Lisp Data Types chapter (@ref{Lisp Data +Types}). Declaring a function with an incorrect type produces undefined behavior -and could lead to unexpected results or might even crash Emacs. Note -also that when redefining (or advising) a type declared function the -replacement should respect the original signature to avoid undefined -behavior. +and could lead to unexpected results or might even crash Emacs when code +is native-compiled and loaded. Note also that when redefining (or +advising) a type declared function the replacement should respect the +original signature to avoid undefined behavior. @item no-font-lock-keyword This is valid for macros only. Macros with this declaration are commit 390b606ffcedd7a14e94631c8ab1155db623e723 Author: Andrea Corallo Date: Thu May 2 12:15:30 2024 +0200 * doc/lispref/functions.texi (Declare Form): Better warn about UB. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 1816ea93e3d..3aa4fc9a457 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2750,9 +2750,10 @@ argument of type @var{string} and return one of the symbols More types are described in @pxref{Lisp Data Types}. -Declaring a function with an incorrect type produces undefined behavior. -Note also that when redefining (or advising) a type declared function -the replacement should respect the original signature to avoid undefined +Declaring a function with an incorrect type produces undefined behavior +and could lead to unexpected results or might even crash Emacs. Note +also that when redefining (or advising) a type declared function the +replacement should respect the original signature to avoid undefined behavior. @item no-font-lock-keyword commit 2f5c9b31161306b2b4c46c77c351c6ea6a46ff98 Author: Mattias EngdegÄrd Date: Thu May 2 13:34:22 2024 +0200 Add lexical cookie to new init files * lisp/cus-edit.el (custom-save-all): Add lexical cookie if the file is empty. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index e7d0eaa9215..2c1ba9bb9d7 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -4971,6 +4971,8 @@ if only the first line of the docstring is shown.")) ;; readably. (Bug#52554) (print-escape-control-characters t)) (atomic-change-group + (when (eobp) + (insert ";;; -*- lexical-binding: t -*-\n")) (custom-save-variables) (custom-save-faces) (custom-save-icons))) commit 59c18389bdd89d48e92c485ba27721490ea03e16 Author: Eli Zaretskii Date: Thu May 2 13:04:15 2024 +0300 ; Fix last change * lisp/progmodes/python.el (python-shell-send-block): Doc fix. * test/lisp/progmodes/python-tests.el (python-test--shell-send-block): Avoid byte-compiler warnings. (Bug#70609) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 57cdf68fc25..5ba185bc60c 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4147,10 +4147,11 @@ interactively." (defun python-shell-send-block (&optional arg msg) "Send the block at point to inferior Python process. The block is delimited by `python-nav-beginning-of-block' and -`python-nav-end-of-block'. When optional argument ARG is non-nil, send -the block body without its header. When optional argument MSG is -non-nil, forces display of a user-friendly message if there's no process -running; defaults to t when called interactively." +`python-nav-end-of-block'. If optional argument ARG is non-nil +(interactively, the prefix argument), send the block body without +its header. If optional argument MSG is non-nil, force display +of a user-friendly message if there's no process running; this +always happens interactively." (interactive (list current-prefix-arg t)) (let ((beg (save-excursion (when (python-nav-beginning-of-block) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 889038d0f8c..f50797953c3 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -7473,9 +7473,9 @@ buffer with overlapping strings." for x in range(1,3): print('current %s' % x) print('current 3')" - (goto-line 1) + (goto-char (point-min)) (should-error (python-shell-send-block) :type 'user-error) - (goto-line 2) + (forward-line) (python-shell-send-block) (python-tests-shell-wait-for-prompt) (python-shell-with-shell-buffer @@ -7484,7 +7484,7 @@ print('current 3')" (should (re-search-forward "current 1" nil t)) (should (re-search-forward "current 2" nil t)) (should-not (re-search-forward "current 3" nil t))) - (goto-line 3) + (forward-line) (python-shell-send-block t) ;; send block body only (python-tests-shell-wait-for-prompt) (python-shell-with-shell-buffer commit b2e92c746eb7d1135d3d4ccecc774d79555ffb99 Author: Lin Sun Date: Sat Apr 27 06:54:27 2024 +0000 New function 'python-shell-send-block' for python-mode * lisp/progmodes/python.el (python-shell-send-block): New function. * test/lisp/progmodes/python-tests.el (python-test--shell-send-block): Test case for the new function. * etc/NEWS: Document 'python-shell-send-block'. (Bug#70609) diff --git a/etc/NEWS b/etc/NEWS index 9d986c06f2f..4d363d300a8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1347,6 +1347,10 @@ instead of: This allows the user to specify command line arguments to the non interactive Python interpreter specified by 'python-interpreter'. +*** New function 'python-shell-send-block'. +It sends the python block delimited by 'python-nav-beginning-of-block' +and 'python-nav-end-of-block' to the inferior Python process. + ** Scheme mode Scheme mode now handles regular expression literal '#/regexp/' that is available in some Scheme implementations. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index ecbec18f518..57cdf68fc25 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -350,6 +350,7 @@ To customize the Python interpreter for interactive use, modify (define-key map "\C-c\C-e" #'python-shell-send-statement) (define-key map "\C-c\C-r" #'python-shell-send-region) (define-key map "\C-\M-x" #'python-shell-send-defun) + (define-key map "\C-c\C-b" #'python-shell-send-block) (define-key map "\C-c\C-c" #'python-shell-send-buffer) (define-key map "\C-c\C-l" #'python-shell-send-file) (define-key map "\C-c\C-z" #'python-shell-switch-to-shell) @@ -390,6 +391,8 @@ To customize the Python interpreter for interactive use, modify :help "Switch to running inferior Python process"] ["Eval string" python-shell-send-string :help "Eval string in inferior Python session"] + ["Eval block" python-shell-send-block + :help "Eval block in inferior Python session"] ["Eval buffer" python-shell-send-buffer :help "Eval buffer in inferior Python session"] ["Eval statement" python-shell-send-statement @@ -4141,6 +4144,27 @@ interactively." (save-excursion (python-nav-end-of-statement)) send-main msg t))) +(defun python-shell-send-block (&optional arg msg) + "Send the block at point to inferior Python process. +The block is delimited by `python-nav-beginning-of-block' and +`python-nav-end-of-block'. When optional argument ARG is non-nil, send +the block body without its header. When optional argument MSG is +non-nil, forces display of a user-friendly message if there's no process +running; defaults to t when called interactively." + (interactive (list current-prefix-arg t)) + (let ((beg (save-excursion + (when (python-nav-beginning-of-block) + (if (null arg) + (beginning-of-line) + (python-nav-end-of-statement) + (beginning-of-line 2))) + (point-marker))) + (end (save-excursion (python-nav-end-of-block))) + (python-indent-guess-indent-offset-verbose nil)) + (if (and beg end) + (python-shell-send-region beg end nil msg t) + (user-error "Can't get code block from current position.")))) + (defun python-shell-send-buffer (&optional send-main msg) "Send the entire buffer to inferior Python process. When optional argument SEND-MAIN is non-nil, allow execution of @@ -7181,6 +7205,7 @@ implementations: `python-mode' and `python-ts-mode'." python-nav-if-name-main python-nav-up-list python-remove-import + python-shell-send-block python-shell-send-buffer python-shell-send-defun python-shell-send-statement diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index e3b1642a975..889038d0f8c 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -7466,6 +7466,33 @@ buffer with overlapping strings." "Unused import a.b.c (unused-import)" "W0611: Unused import a.b.c (unused-import)")))))) +(ert-deftest python-test--shell-send-block () + (skip-unless (executable-find python-tests-shell-interpreter)) + (python-tests-with-temp-buffer-with-shell + "print('current 0') +for x in range(1,3): + print('current %s' % x) +print('current 3')" + (goto-line 1) + (should-error (python-shell-send-block) :type 'user-error) + (goto-line 2) + (python-shell-send-block) + (python-tests-shell-wait-for-prompt) + (python-shell-with-shell-buffer + (goto-char (point-min)) + (should-not (re-search-forward "current 0" nil t)) + (should (re-search-forward "current 1" nil t)) + (should (re-search-forward "current 2" nil t)) + (should-not (re-search-forward "current 3" nil t))) + (goto-line 3) + (python-shell-send-block t) ;; send block body only + (python-tests-shell-wait-for-prompt) + (python-shell-with-shell-buffer + ;; should only 1 line output from the block body + (should (re-search-forward "current")) + (should (looking-at " 2")) + (should-not (re-search-forward "current" nil t))))) + ;;; python-ts-mode font-lock tests (defmacro python-ts-tests-with-temp-buffer (contents &rest body) commit bf00762745c07816e7a9c64e0fce037039852971 Author: Ihor Radchenko Date: Tue Apr 30 14:27:04 2024 +0300 Improve performance of `file-truename' (bug#70036) * lisp/files.el (file-truename): Avoid repetitive calls to `file-name-nondirectory'. These calls contribute significantly to CPU time. See the benchmarks in https://debbugs.gnu.org/cgi/bugreport.cgi?bug=70036#47 diff --git a/lisp/files.el b/lisp/files.el index 7dec67c5cf0..b7ebb727c72 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1504,27 +1504,28 @@ containing it, until no links are left at any level. (new (file-name-as-directory (file-truename dirfile counter prev-dirs)))) (setcar prev-dirs (cons (cons old new) (car prev-dirs))) (setq dir new)))) - (if (equal ".." (file-name-nondirectory filename)) - (setq filename - (directory-file-name (file-name-directory (directory-file-name dir))) - done t) - (if (equal "." (file-name-nondirectory filename)) - (setq filename (directory-file-name dir) - done t) - ;; Put it back on the file name. - (setq filename (concat dir (file-name-nondirectory filename))) - ;; Is the file name the name of a link? - (setq target (file-symlink-p filename)) - (if target - ;; Yes => chase that link, then start all over - ;; since the link may point to a directory name that uses links. - ;; We can't safely use expand-file-name here - ;; since target might look like foo/../bar where foo - ;; is itself a link. Instead, we handle . and .. above. - (setq filename (files--splice-dirname-file dir target) - done nil) - ;; No, we are done! - (setq done t)))))))) + (let ((filename-no-dir (file-name-nondirectory filename))) + (if (equal ".." filename-no-dir) + (setq filename + (directory-file-name (file-name-directory (directory-file-name dir))) + done t) + (if (equal "." filename-no-dir) + (setq filename (directory-file-name dir) + done t) + ;; Put it back on the file name. + (setq filename (concat dir filename-no-dir)) + ;; Is the file name the name of a link? + (setq target (file-symlink-p filename)) + (if target + ;; Yes => chase that link, then start all over + ;; since the link may point to a directory name that uses links. + ;; We can't safely use expand-file-name here + ;; since target might look like foo/../bar where foo + ;; is itself a link. Instead, we handle . and .. above. + (setq filename (files--splice-dirname-file dir target) + done nil) + ;; No, we are done! + (setq done t))))))))) filename)) (defun file-chase-links (filename &optional limit) commit d15efe965d8317bb5413a8aa8caabcb9f5382206 Author: kobarity Date: Tue Apr 30 14:10:57 2024 +0900 Add ExceptionGroup as a Python keyword * lisp/progmodes/python.el (python-font-lock-keywords-maximum-decoration) (python--treesit-exceptions): Add ExceptionGroup. (Bug#70653) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 4ff5e9d4878..ecbec18f518 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -785,6 +785,7 @@ sign in chained assignment." "InterruptedError" "IsADirectoryError" "NotADirectoryError" "PermissionError" "ProcessLookupError" "RecursionError" "ResourceWarning" "StopAsyncIteration" "TimeoutError" + "ExceptionGroup" ;; OS specific "VMSError" "WindowsError" ) @@ -1052,6 +1053,7 @@ It makes underscores and dots word constituent chars.") "InterruptedError" "IsADirectoryError" "NotADirectoryError" "PermissionError" "ProcessLookupError" "RecursionError" "ResourceWarning" "StopAsyncIteration" "TimeoutError" + "ExceptionGroup" ;; OS specific "VMSError" "WindowsError" )) commit ef6ffbdc79645e719d3b5ef23c9200405c58c61e Author: Po Lu Date: Thu May 2 16:56:26 2024 +0800 Fix display of stipples on NS with respect to cursor highlight * src/nsfont.m (nsfont_draw): Delete redundant code. * src/nsterm.m (ns_maybe_dumpglyphs_background): Conform logic to X version by always displaying the background if s->stipple_p should be set. (ns_draw_stretch_glyph_string): Set stipple background as appropriate. (ns_set_glyph_string_gc): New function. (ns_draw_glyph_string): Call it, as on X. Reported by Arash Esbati . diff --git a/src/nsfont.m b/src/nsfont.m index 4e1d85a5c4a..e1b1b097c17 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -1180,21 +1180,12 @@ is false when (FROM > 0 || TO < S->nchars). */ { NSRect br = NSMakeRect (x, y - FONT_BASE (s->font), s->width, FONT_HEIGHT (s->font)); - - if (!s->face->stipple) - { - if (s->hl != DRAW_CURSOR) - [(NS_FACE_BACKGROUND (face) != 0 - ? [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)] - : FRAME_BACKGROUND_COLOR (s->f)) set]; - else - [FRAME_CURSOR_COLOR (s->f) set]; - } + if (s->hl != DRAW_CURSOR) + [(NS_FACE_BACKGROUND (face) != 0 + ? [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)] + : FRAME_BACKGROUND_COLOR (s->f)) set]; else - { - struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f); - [[dpyinfo->bitmaps[face->stipple-1].img stippleMask] set]; - } + [FRAME_CURSOR_COLOR (s->f) set]; NSRectFill (br); } diff --git a/src/nsterm.m b/src/nsterm.m index 71fa6e22164..f26cdb17903 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -3808,7 +3808,6 @@ Function modeled after x_draw_glyph_string_box (). } } - static void ns_maybe_dumpglyphs_background (struct glyph_string *s, char force_p) /* -------------------------------------------------------------------------- @@ -3816,45 +3815,47 @@ Function modeled after x_draw_glyph_string_box (). certain cases. Others are left to the text rendering routine. -------------------------------------------------------------------------- */ { + struct face *face = s->face; + NSRect r; + NSTRACE ("ns_maybe_dumpglyphs_background"); - if (!s->background_filled_p/* || s->hl == DRAW_MOUSE_FACE*/) + if (!s->background_filled_p) { int box_line_width = max (s->face->box_horizontal_line_width, 0); - if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width - /* When xdisp.c ignores FONT_HEIGHT, we cannot trust font - dimensions, since the actual glyphs might be much - smaller. So in that case we always clear the rectangle - with background color. */ - || FONT_TOO_HIGH (s->font) - || s->font_not_found_p || s->extends_to_end_of_line_p || force_p) + if (s->stippled_p) { - struct face *face = s->face; - if (!face->stipple) - { - if (s->hl != DRAW_CURSOR) - [(NS_FACE_BACKGROUND (face) != 0 - ? [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)] - : FRAME_BACKGROUND_COLOR (s->f)) set]; - else if (face && (NS_FACE_BACKGROUND (face) - == [(NSColor *) FRAME_CURSOR_COLOR (s->f) - unsignedLong])) - [[NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (face)] set]; - else - [FRAME_CURSOR_COLOR (s->f) set]; - } - else - { - struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f); - [[dpyinfo->bitmaps[face->stipple-1].img stippleMask] set]; - } + struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f); + [[dpyinfo->bitmaps[face->stipple-1].img stippleMask] set]; + goto fill; + } + else if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width + /* When xdisp.c ignores FONT_HEIGHT, we cannot trust font + dimensions, since the actual glyphs might be much + smaller. So in that case we always clear the + rectangle with background color. */ + || FONT_TOO_HIGH (s->font) + || s->font_not_found_p + || s->extends_to_end_of_line_p + || force_p) + { + if (s->hl != DRAW_CURSOR) + [(NS_FACE_BACKGROUND (face) != 0 + ? [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)] + : FRAME_BACKGROUND_COLOR (s->f)) set]; + else if (face && (NS_FACE_BACKGROUND (face) + == [(NSColor *) FRAME_CURSOR_COLOR (s->f) + unsignedLong])) + [[NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (face)] set]; + else + [FRAME_CURSOR_COLOR (s->f) set]; - NSRect r = NSMakeRect (s->x, s->y + box_line_width, - s->background_width, - s->height - 2 * box_line_width); + fill: + r = NSMakeRect (s->x, s->y + box_line_width, + s->background_width, + s->height - 2 * box_line_width); NSRectFill (r); - s->background_filled_p = 1; } } @@ -4083,8 +4084,7 @@ Function modeled after x_draw_glyph_string_box (). struct face *face; NSColor *fg_color; - if (s->hl == DRAW_CURSOR - && !x_stretch_cursor_p) + if (s->hl == DRAW_CURSOR && !x_stretch_cursor_p) { /* If `x-stretch-cursor' is nil, don't draw a block cursor as wide as the stretch glyph. */ @@ -4170,8 +4170,13 @@ Function modeled after x_draw_glyph_string_box (). if (background_width > 0) { + struct ns_display_info *dpyinfo; + + dpyinfo = FRAME_DISPLAY_INFO (s->f); if (s->hl == DRAW_CURSOR) [FRAME_CURSOR_COLOR (s->f) set]; + else if (s->stippled_p) + [[dpyinfo->bitmaps[s->face->stipple - 1].img stippleMask] set]; else [[NSColor colorWithUnsignedLong: s->face->background] set]; @@ -4389,6 +4394,45 @@ Function modeled after x_draw_glyph_string_box (). s->char2b = NULL; } +/* Transfer glyph string parameters from S's face to S itself. + Set S->stipple_p as appropriate, taking the draw type into + account. */ + +static void +ns_set_glyph_string_gc (struct glyph_string *s) +{ + prepare_face_for_display (s->f, s->face); + + if (s->hl == DRAW_NORMAL_TEXT) + { + /* s->gc = s->face->gc; */ + s->stippled_p = s->face->stipple != 0; + } + else if (s->hl == DRAW_INVERSE_VIDEO) + { + /* x_set_mode_line_face_gc (s); */ + s->stippled_p = s->face->stipple != 0; + } + else if (s->hl == DRAW_CURSOR) + { + /* x_set_cursor_gc (s); */ + s->stippled_p = false; + } + else if (s->hl == DRAW_MOUSE_FACE) + { + /* x_set_mouse_face_gc (s); */ + s->stippled_p = s->face->stipple != 0; + } + else if (s->hl == DRAW_IMAGE_RAISED + || s->hl == DRAW_IMAGE_SUNKEN) + { + /* s->gc = s->face->gc; */ + s->stippled_p = s->face->stipple != 0; + } + else + emacs_abort (); +} + static void ns_draw_glyph_string (struct glyph_string *s) /* -------------------------------------------------------------------------- @@ -4414,6 +4458,7 @@ Function modeled after x_draw_glyph_string_box (). width += next->width, next = next->next) if (next->first_glyph->type != IMAGE_GLYPH) { + ns_set_glyph_string_gc (next); n = ns_get_glyph_string_clip_rect (s->next, r); ns_focus (s->f, r, n); if (next->first_glyph->type != STRETCH_GLYPH) @@ -4425,6 +4470,8 @@ Function modeled after x_draw_glyph_string_box (). } } + ns_set_glyph_string_gc (s); + if (!s->for_overlaps && s->face->box != FACE_NO_BOX && (s->first_glyph->type == CHAR_GLYPH || s->first_glyph->type == COMPOSITE_GLYPH)) commit 0e0fe20040413d682f8078a2ddfb8f502cb89fb8 Author: Lin Sun Date: Thu Apr 25 06:54:27 2024 +0000 ; Fix python test case for testing completion with ipython * test/lisp/progmodes/python-tests.el (python-shell-completion-at-point-ipython): Fix value of 'python-test-shell-interpreter'. (Bug#70578) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 878f60f1614..e3b1642a975 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -4896,7 +4896,8 @@ def foo(): (ert-deftest python-shell-completion-at-point-ipython () "Check if Python shell completion works for IPython." - (let ((python-shell-interpreter "ipython") + (let ((python-tests-shell-interpreter "ipython") + (python-shell-interpreter "ipython") (python-shell-interpreter-args "-i --simple-prompt")) (skip-unless (and commit b98a6af8ca086ddbf891e54e50d0cb3f578f42b5 Author: Augusto Stoffel Date: Sun Apr 21 11:21:58 2024 +0200 Eglot: Add 'command-modes' property to all suitable commands Those are the commands that call 'eglot--current-server-or-lose'. * lisp/progmodes/eglot.el (eglot--managed-mode), (eglot-list-connections-mode): Make non-interactive. (Bug#70554) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index a2ef0599305..407707d4122 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1977,7 +1977,7 @@ Use `eglot-managed-p' to determine if current buffer is managed.") (define-minor-mode eglot--managed-mode "Mode for source buffers managed by some Eglot project." - :init-value nil :lighter nil :keymap eglot-mode-map + :init-value nil :lighter nil :keymap eglot-mode-map :interactive nil (cond (eglot--managed-mode (pcase (plist-get (eglot--capabilities (eglot-current-server)) @@ -3954,6 +3954,7 @@ If NOERROR, return predicate, else erroring function." (define-derived-mode eglot-list-connections-mode tabulated-list-mode "" "Eglot mode for listing server connections \\{eglot-list-connections-mode-map}" + :interactive nil (setq-local tabulated-list-format `[("Language server" 16) ("Project name" 16) ("Modes handled" 16)]) (tabulated-list-init-header)) @@ -4143,6 +4144,27 @@ If NOERROR, return predicate, else erroring function." "https://debbugs.gnu.org/%s") (match-string 3)))) +;; Add command-mode property manually for compatibility with Emacs < 28. +(dolist (sym '(eglot-clear-status + eglot-code-action-inline + eglot-code-action-organize-imports + eglot-code-action-quickfix + eglot-code-action-rewrite + eglot-code-action-rewrite + eglot-code-actions + eglot-find-declaration + eglot-find-implementation + eglot-find-typeDefinition + eglot-forget-pending-continuations + eglot-format + eglot-format-buffer + eglot-inlay-hints-mode + eglot-reconnect + eglot-rename + eglot-signal-didChangeConfiguration + eglot-stderr-buffer)) + (function-put sym 'command-modes '(eglot--managed-mode))) + (provide 'eglot) commit 8e1e8099aad0fbb2bc375b45379913b8ca55e926 Author: Andrea Corallo Date: Wed May 1 22:49:01 2024 +0200 * etc/NEWS (Function type declaration): Add entry. diff --git a/etc/NEWS b/etc/NEWS index 4b0106fcb07..73dbe3b2b83 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1935,6 +1935,10 @@ unibyte string. * Lisp Changes in Emacs 30.1 +** Function type declaration +It is now possible, using the 'declare' macro, to declare expected types +of function arguments and return type. + ** New types 'closure' and 'interpreted-function'. 'interpreted-function' is the new type used for interpreted functions, and 'closure' is the common parent type of 'interpreted-function' commit fccd35f2c89a50675ed8c14d4814b603fd4fa166 Author: Andrea Corallo Date: Wed May 1 20:03:02 2024 +0200 * doc/lispref/functions.texi (Declare Form): Improve declare type. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index b5e234fa068..1816ea93e3d 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2716,6 +2716,45 @@ native compiler (@pxref{Native-Compilation}) for improving code generation and for deriving more precisely the type of other functions without type declaration. +@var{type} is a type specifier in the form @code{(function (ARG-1-TYPE +... ARG-N-TYPE) RETURN-TYPE)}. Argument types can be interleaved with +symbols @code{&optional} and @code{&rest} to match the @pxref{Argument +List} of the function. + +Here's an example of using @code{type} inside @code{declare} to declare +a function @code{positive-p} that takes an argument of type @var{number} +and return a @var{boolean}: + +@lisp +(defun positive-p (x) + (declare (type (function (number) boolean))) + (when (> x 0) + t)) +@end lisp + +Similarly this declares a function @code{cons-or-number} that: expects a +first argument being a @var{cons} or a @var{number}, a second optional +argument of type @var{string} and return one of the symbols +@code{is-cons} or @code{is-number}: + +@lisp +(defun cons-or-number (x &optional err-msg) + (declare (type (function ((or cons number) &optional string) + (member is-cons is-number)))) + (if (consp x) + 'is-cons + (if (numberp x) + 'is-number + (error (or err-msg "Unexpected input"))))) +@end lisp + +More types are described in @pxref{Lisp Data Types}. + +Declaring a function with an incorrect type produces undefined behavior. +Note also that when redefining (or advising) a type declared function +the replacement should respect the original signature to avoid undefined +behavior. + @item no-font-lock-keyword This is valid for macros only. Macros with this declaration are highlighted by font-lock (@pxref{Font Lock Mode}) as normal functions, commit 1087d55d2710f610edc5195175e2260aebaa4589 Author: Andrea Corallo Date: Tue Apr 30 09:19:31 2024 +0200 * lisp/emacs-lisp/regexp-opt.el (regexp-opt): Fix type declaration. diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index 076232bc613..f23343a34c6 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -130,7 +130,7 @@ usually more efficient than that of a simplified version: (concat (car parens) (mapconcat \\='regexp-quote strings \"\\\\|\") (cdr parens))))" - (declare (type (function (list) string)) + (declare (type (function (list &optional t) string)) (pure t) (side-effect-free t)) (save-match-data ;; Recurse on the sorted list. commit 0757ea98654bef58d19a46ce2f7ce1a715ec65ca Author: Andrea Corallo Date: Mon Apr 29 20:31:05 2024 +0200 Rename property 'declared-type' to 'function-type' * lisp/emacs-lisp/byte-run.el (byte-run--set-function-type): Rename. (defun-declarations-alist): Update. * lisp/emacs-lisp/comp.el (comp--get-function-cstr): Likewise. diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 88571593c31..84cc83f2270 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -217,10 +217,10 @@ So far, FUNCTION can only be a symbol, not a lambda expression." (cadr elem))) val))))) -(defalias 'byte-run--set-declared-type +(defalias 'byte-run--set-function-type #'(lambda (f _args &rest val) (list 'function-put (list 'quote f) - ''declared-type (list 'quote val)))) + ''function-type (list 'quote val)))) ;; Add any new entries to info node `(elisp)Declare Form'. (defvar defun-declarations-alist @@ -245,7 +245,7 @@ If `error-free', drop calls even if `byte-compile-delete-errors' is nil.") (list 'completion #'byte-run--set-completion) (list 'modes #'byte-run--set-modes) (list 'interactive-args #'byte-run--set-interactive-args) - (list 'type #'byte-run--set-declared-type)) + (list 'type #'byte-run--set-function-type)) "List associating function properties to their macro expansion. Each element of the list takes the form (PROP FUN) where FUN is a function. For each (PROP . VALUES) in a function's declaration, diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index dea7af66a0c..ef40882a98a 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -515,7 +515,7 @@ itself." (let ((f (and (symbolp function) (symbol-function function)))) (when (and f (null type-spec)) - (if-let ((delc-type (function-get function 'declared-type))) + (if-let ((delc-type (function-get function 'function-type))) ;; Declared Lisp function (setf type-spec (car delc-type)) (when (subr-native-elisp-p f) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index b37af4c8dc2..d7cd6b79c86 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -194,7 +194,7 @@ Useful to hook into pass checkers.") (when (symbolp function) (let ((f (symbol-function function))) (or (gethash f comp-primitive-func-cstr-h) - (when-let ((res (function-get function 'declared-type))) + (when-let ((res (function-get function 'function-type))) (comp-type-spec-to-cstr (car res))))))) ;; Keep it in sync with the `cl-deftype-satisfies' property set in commit 15016288ecaefbfb2822c1fcef7146a5d8663650 Author: Andrea Corallo Date: Mon Apr 29 18:08:57 2024 +0200 * Document function type declarations * doc/lispref/functions.texi (Declare Form): Document function type declaration. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index c57de08460f..b5e234fa068 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2709,6 +2709,13 @@ native code emitted for the function. In particular, if @var{n} is @minus{}1, native compilation of the function will emit bytecode instead of native code for the function. +@item (type @var{type}) +Declare @var{type} to be the type of this function. This is used for +documentation by @code{describe-function}. Also it can be used by the +native compiler (@pxref{Native-Compilation}) for improving code +generation and for deriving more precisely the type of other functions +without type declaration. + @item no-font-lock-keyword This is valid for macros only. Macros with this declaration are highlighted by font-lock (@pxref{Font Lock Mode}) as normal functions, commit fa0bf96837ad267e5259e531e3d592dd40fdc445 Author: Andrea Corallo Date: Wed Apr 10 22:07:16 2024 +0200 Move lisp function arg type declarations to the functions itself * lisp/emacs-lisp/comp-common.el (comp-primitive-type-specifiers): Remove type declaration of lisp functions. * lisp/window.el (get-lru-window, get-largest-window) (one-window-p): Declare type. * lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh) (last, eventp, mouse-movement-p, log10, memory-limit) (interactive-p): Likewise. * lisp/simple.el (count-lines, mark, lax-plist-get): Likewise. * lisp/files.el (parse-colon-path): Likewise. * lisp/env.el (getenv): Likewise. * lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise. * lisp/emacs-lisp/lisp.el (buffer-end): Likewise. * lisp/emacs-lisp/comp.el (comp-hint-fixnum, comp-hint-cons): Likewise. * lisp/custom.el (custom-variable-p): Likewise. diff --git a/lisp/custom.el b/lisp/custom.el index a19b14aaf8a..6f2aa18ba1d 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -667,7 +667,8 @@ If NOSET is non-nil, don't bother autoloading LOAD when setting the variable." A customizable variable is either (i) a variable whose property list contains a non-nil `standard-value' or `custom-autoload' property, or (ii) an alias for another customizable variable." - (declare (side-effect-free t)) + (declare (type (function (symbol) t)) + (side-effect-free t)) (when (symbolp variable) (setq variable (indirect-variable variable)) (or (get variable 'standard-value) diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index cfaf843a3fd..dea7af66a0c 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -68,7 +68,7 @@ Used to modify the compiler environment." :risky t :version "28.1") -(defconst comp-known-type-specifiers +(defconst comp-primitive-type-specifiers `( ;; Functions we can trust not to be redefined, or, if redefined, ;; to expose the same type. The vast majority of these are @@ -97,7 +97,6 @@ Used to modify the compiler environment." (assq (function (t list) list)) (atan (function (number &optional number) float)) (atom (function (t) boolean)) - (bignump (function (t) boolean)) (bobp (function () boolean)) (bolp (function () boolean)) (bool-vector-count-consecutive @@ -107,7 +106,6 @@ Used to modify the compiler environment." (bool-vector-p (function (t) boolean)) (bool-vector-subsetp (function (bool-vector bool-vector) boolean)) (boundp (function (symbol) boolean)) - (buffer-end (function ((or number marker)) integer)) (buffer-file-name (function (&optional buffer) (or string null))) (buffer-list (function (&optional frame) list)) (buffer-local-variables (function (&optional buffer) list)) @@ -157,8 +155,6 @@ Used to modify the compiler environment." (copy-sequence (function (sequence) sequence)) (copysign (function (float float) float)) (cos (function (number) float)) - (count-lines - (function ((or integer marker) (or integer marker) &optional t) integer)) (current-buffer (function () buffer)) (current-global-map (function () cons)) (current-indentation (function () integer)) @@ -171,7 +167,6 @@ Used to modify the compiler environment." (current-time-zone (function (&optional (or number list) (or symbol string cons integer)) cons)) - (custom-variable-p (function (symbol) t)) (decode-char (function (cons t) (or fixnum null))) (decode-time (function (&optional (or number list) (or symbol string cons integer) @@ -179,7 +174,6 @@ Used to modify the compiler environment." cons)) (default-boundp (function (symbol) boolean)) (default-value (function (symbol) t)) - (degrees-to-radians (function (number) float)) (documentation (function ((or function symbol subr) &optional t) (or null string))) (downcase (function ((or fixnum string)) (or fixnum string))) @@ -192,7 +186,6 @@ Used to modify the compiler environment." (eql (function (t t) boolean)) (equal (function (t t) boolean)) (error-message-string (function (list) string)) - (eventp (function (t) boolean)) (exp (function (number) float)) (expt (function (number number) number)) (fboundp (function (symbol) boolean)) @@ -207,7 +200,6 @@ Used to modify the compiler environment." (file-readable-p (function (string) boolean)) (file-symlink-p (function (string) (or boolean string))) (file-writable-p (function (string) boolean)) - (fixnump (function (t) boolean)) (float (function (number) float)) (float-time (function (&optional (or number list)) float)) (floatp (function (t) boolean)) @@ -230,18 +222,12 @@ Used to modify the compiler environment." (function (&optional (or buffer string) (or symbol (integer 0 0))) (or null window))) (get-file-buffer (function (string) (or null buffer))) - (get-largest-window (function (&optional t t t) (or window null))) - (get-lru-window (function (&optional t t t) (or window null))) - (getenv (function (string &optional frame) (or null string))) (gethash (function (t hash-table &optional t) t)) (hash-table-count (function (hash-table) integer)) (hash-table-p (function (t) boolean)) (identity (function (t) t)) - (ignore (function (&rest t) null)) - (int-to-string (function (number) string)) (integer-or-marker-p (function (t) boolean)) (integerp (function (t) boolean)) - (interactive-p (function () boolean)) (intern-soft (function ((or string symbol) &optional (or obarray vector)) symbol)) (invocation-directory (function () string)) @@ -250,8 +236,6 @@ Used to modify the compiler environment." (keymap-parent (function (cons) (or cons null))) (keymapp (function (t) boolean)) (keywordp (function (t) boolean)) - (last (function (list &optional integer) list)) - (lax-plist-get (function (list t) t)) (ldexp (function (number integer) float)) (length (function (t) (integer 0 *))) (length< (function (sequence fixnum) boolean)) @@ -265,7 +249,6 @@ Used to modify the compiler environment." (local-variable-p (function (symbol &optional buffer) boolean)) (locale-info (function ((member codeset days months paper)) (or null string))) (log (function (number number) float)) - (log10 (function (number) float)) (logand (function (&rest (or integer marker)) integer)) (logb (function (number) integer)) (logcount (function (integer) integer)) @@ -273,7 +256,6 @@ Used to modify the compiler environment." (lognot (function (integer) integer)) (logxor (function (&rest (or integer marker)) integer)) ;; (lsh (function ((integer ,most-negative-fixnum *) integer) integer)) ? - (lsh (function (integer integer) integer)) (make-byte-code (function ((or fixnum list) string vector integer &optional string t &rest t) @@ -282,14 +264,12 @@ Used to modify the compiler environment." (make-marker (function () marker)) (make-string (function (integer fixnum &optional t) string)) (make-symbol (function (string) symbol)) - (mark (function (&optional t) (or integer null))) (mark-marker (function () marker)) (marker-buffer (function (marker) (or buffer null))) (markerp (function (t) boolean)) (max (function ((or number marker) &rest (or number marker)) number)) (max-char (function (&optional t) fixnum)) (member (function (t list) list)) - (memory-limit (function () integer)) (memq (function (t list) list)) (memql (function (t list) list)) (min (function ((or number marker) &rest (or number marker)) number)) @@ -298,7 +278,6 @@ Used to modify the compiler environment." (mod (function ((or number marker) (or number marker)) (or (integer 0 *) (float 0 *)))) - (mouse-movement-p (function (t) boolean)) (multibyte-char-to-unibyte (function (fixnum) fixnum)) (natnump (function (t) boolean)) (next-window (function (&optional window t t) window)) @@ -310,9 +289,7 @@ Used to modify the compiler environment." (number-or-marker-p (function (t) boolean)) (number-to-string (function (number) string)) (numberp (function (t) boolean)) - (one-window-p (function (&optional t t) boolean)) (overlayp (function (t) boolean)) - (parse-colon-path (function (string) list)) (plist-get (function (list t &optional t) t)) (plist-member (function (list t &optional t) list)) (point (function () integer)) @@ -325,13 +302,11 @@ Used to modify the compiler environment." (processp (function (t) boolean)) (proper-list-p (function (t) (or fixnum null))) (propertize (function (string &rest t) string)) - (radians-to-degrees (function (number) float)) (rassoc (function (t list) list)) (rassq (function (t list) list)) (read-from-string (function (string &optional integer integer) cons)) (recent-keys (function (&optional (or cons null)) vector)) (recursion-depth (function () integer)) - (regexp-opt (function (list) string)) (regexp-quote (function (string) string)) (region-beginning (function () integer)) (region-end (function () integer)) @@ -387,7 +362,6 @@ Used to modify the compiler environment." (upcase (function ((or fixnum string)) (or fixnum string))) (user-full-name (function (&optional integer) (or string null))) (user-login-name (function (&optional integer) (or string null))) - (user-original-login-name (function (&optional integer) (or string null))) (user-real-login-name (function () string)) (user-real-uid (function () integer)) (user-uid (function () integer)) @@ -400,13 +374,8 @@ Used to modify the compiler environment." (window-live-p (function (t) boolean)) (window-valid-p (function (t) boolean)) (windowp (function (t) boolean)) - (zerop (function (number) boolean)) - ;; Type hints - (comp-hint-fixnum (function (t) fixnum)) - (comp-hint-cons (function (t) cons)) ;; Non returning functions (throw (function (t t) nil)) - (error (function (string &rest t) nil)) (signal (function (symbol t) nil))) "Alist used for type propagation.") @@ -536,11 +505,11 @@ This function returns a cons cell whose car is the function specifier, and cdr is a symbol, either `inferred' or `declared'. If the symbol is `inferred', the type specifier is automatically inferred from the code itself by the native compiler; if it is `declared', the type specifier -comes from `comp-known-type-specifiers' or the function type declaration +comes from `comp-primitive-type-specifiers' or the function type declaration itself." (let ((kind 'declared) type-spec) - (when-let ((res (assoc function comp-known-type-specifiers))) + (when-let ((res (assoc function comp-primitive-type-specifiers))) ;; Declared primitive (setf type-spec (cadr res))) (let ((f (and (symbolp function) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index a7d4c71dc26..b37af4c8dc2 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3309,11 +3309,13 @@ Prepare every function for final compilation and drive the C back-end." ;; are assumed just to be true. Use with extreme caution... (defun comp-hint-fixnum (x) - (declare (gv-setter (lambda (val) `(setf ,x ,val)))) + (declare (type (function (t) fixnum)) + (gv-setter (lambda (val) `(setf ,x ,val)))) x) (defun comp-hint-cons (x) - (declare (gv-setter (lambda (val) `(setf ,x ,val)))) + (declare (type (function (t) cons)) + (gv-setter (lambda (val) `(setf ,x ,val)))) x) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 7e6db51b1d5..9edc11ad132 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -534,7 +534,8 @@ major mode's decisions about context.") "Return the \"far end\" position of the buffer, in direction ARG. If ARG is positive, that's the end of the buffer. Otherwise, that's the beginning of the buffer." - (declare (side-effect-free error-free)) + (declare (type (function ((or number marker)) integer)) + (side-effect-free error-free)) (if (> arg 0) (point-max) (point-min))) (defun end-of-defun (&optional arg interactive) diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index 59c1b7d8e10..076232bc613 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -130,7 +130,8 @@ usually more efficient than that of a simplified version: (concat (car parens) (mapconcat \\='regexp-quote strings \"\\\\|\") (cdr parens))))" - (declare (pure t) (side-effect-free t)) + (declare (type (function (list) string)) + (pure t) (side-effect-free t)) (save-match-data ;; Recurse on the sorted list. (let* ((max-lisp-eval-depth 10000) diff --git a/lisp/env.el b/lisp/env.el index e0a8df8476c..7d0c7dd0126 100644 --- a/lisp/env.el +++ b/lisp/env.el @@ -207,7 +207,8 @@ parameter. Otherwise, this function searches `process-environment' for VARIABLE. If it is not found there, then it continues the search in the environment list of the selected frame." - (declare (side-effect-free t)) + (declare (type (function (string &optional frame) (or null string))) + (side-effect-free t)) (interactive (list (read-envvar-name "Get environment variable: " t))) (let ((value (getenv-internal (if (multibyte-string-p variable) (encode-coding-string diff --git a/lisp/files.el b/lisp/files.el index 7dec67c5cf0..57f3042e4da 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -862,6 +862,7 @@ GNU and Unix systems). Substitute environment variables into the resulting list of directory names. For an empty path element (i.e., a leading or trailing separator, or two adjacent separators), return nil (meaning `default-directory') as the associated list element." + (declare (type (function (string) list))) (when (stringp search-path) (let ((spath (substitute-env-vars search-path)) (double-slash-special-p diff --git a/lisp/simple.el b/lisp/simple.el index be64f3574e0..a459f6ecfd2 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1762,7 +1762,9 @@ not at the start of a line. When IGNORE-INVISIBLE-LINES is non-nil, invisible lines are not included in the count." - (declare (side-effect-free t)) + (declare (type (function ((or integer marker) (or integer marker) &optional t) + integer)) + (side-effect-free t)) (save-excursion (save-restriction (narrow-to-region start end) @@ -6882,7 +6884,8 @@ is active, and returns an integer or nil in the usual way. If you are using this in an editing command, you are most likely making a mistake; see the documentation of `set-mark'." - (declare (side-effect-free t)) + (declare (type (function (&optional t) (or integer null))) + (side-effect-free t)) (if (or force (not transient-mark-mode) mark-active mark-even-if-inactive) (marker-position (mark-marker)) (signal 'mark-inactive nil))) @@ -11163,7 +11166,8 @@ killed." (defun lax-plist-get (plist prop) "Extract a value from a property list, comparing with `equal'." - (declare (pure t) (side-effect-free t) (obsolete plist-get "29.1")) + (declare (type (function (list t) t)) + (pure t) (side-effect-free t) (obsolete plist-get "29.1")) (plist-get plist prop #'equal)) (defun lax-plist-put (plist prop val) diff --git a/lisp/subr.el b/lisp/subr.el index 352ecc315ef..92d1e50ab2c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -451,7 +451,8 @@ This function accepts any number of arguments in ARGUMENTS. Also see `always'." ;; Not declared `side-effect-free' because we don't want calls to it ;; elided; see `byte-compile-ignore'. - (declare (pure t) (completion ignore)) + (declare (type (function (&rest t) null)) + (pure t) (completion ignore)) (interactive) nil) @@ -480,7 +481,8 @@ for the sake of consistency. To alter the look of the displayed error messages, you can use the `command-error-function' variable." - (declare (advertised-calling-convention (string &rest args) "23.1")) + (declare (type (function (string &rest t) nil)) + (advertised-calling-convention (string &rest args) "23.1")) (signal 'error (list (apply #'format-message args)))) (defun user-error (format &rest args) @@ -545,19 +547,22 @@ was called." "Return t if NUMBER is zero." ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because ;; = has a byte-code. - (declare (pure t) (side-effect-free t) + (declare (type (function (number) boolean)) + (pure t) (side-effect-free t) (compiler-macro (lambda (_) `(= 0 ,number)))) (= 0 number)) (defun fixnump (object) "Return t if OBJECT is a fixnum." - (declare (side-effect-free error-free)) + (declare (type (function (t) boolean)) + (side-effect-free error-free)) (and (integerp object) (<= most-negative-fixnum object most-positive-fixnum))) (defun bignump (object) "Return t if OBJECT is a bignum." - (declare (side-effect-free error-free)) + (declare (type (function (t) boolean)) + (side-effect-free error-free)) (and (integerp object) (not (fixnump object)))) (defun lsh (value count) @@ -570,7 +575,8 @@ Most uses of this function turn out to be mistakes. We recommend to use `ash' instead, unless COUNT could ever be negative, and if, when COUNT is negative, your program really needs the special treatment of negative COUNT provided by this function." - (declare (compiler-macro + (declare (type (function (integer integer) integer)) + (compiler-macro (lambda (form) (macroexp-warn-and-return (format-message "avoid `lsh'; use `ash' instead") @@ -748,7 +754,8 @@ treatment of negative COUNT provided by this function." If LIST is nil, return nil. If N is non-nil, return the Nth-to-last link of LIST. If N is bigger than the length of LIST, return LIST." - (declare (pure t) (side-effect-free t)) ; pure up to mutation + (declare (type (function (list &optional integer) list)) + (pure t) (side-effect-free t)) ; pure up to mutation (if n (and (>= n 0) (let ((m (safe-length list))) @@ -1585,7 +1592,8 @@ See also `current-global-map'.") (defun eventp (object) "Return non-nil if OBJECT is an input event or event object." - (declare (pure t) (side-effect-free error-free)) + (declare (type (function (t) boolean)) + (pure t) (side-effect-free error-free)) (or (integerp object) (and (if (consp object) (setq object (car object)) @@ -1652,7 +1660,8 @@ in the current Emacs session, then this function may return nil." (defsubst mouse-movement-p (object) "Return non-nil if OBJECT is a mouse movement event." - (declare (side-effect-free error-free)) + (declare (type (function (t) boolean)) + (side-effect-free error-free)) (eq (car-safe object) 'mouse-movement)) (defun mouse-event-p (object) @@ -1961,7 +1970,8 @@ be a list of the form returned by `event-start' and `event-end'." (defun log10 (x) "Return (log X 10), the log base 10 of X." - (declare (side-effect-free t) (obsolete log "24.4")) + (declare (type (function (number) float)) + (side-effect-free t) (obsolete log "24.4")) (log x 10)) (set-advertised-calling-convention @@ -3245,7 +3255,8 @@ It can be retrieved with `(process-get PROCESS PROPNAME)'." (defun memory-limit () "Return an estimate of Emacs virtual memory usage, divided by 1024." - (declare (side-effect-free error-free)) + (declare (type (function () integer)) + (side-effect-free error-free)) (let ((default-directory temporary-file-directory)) (or (cdr (assq 'vsize (process-attributes (emacs-pid)))) 0))) @@ -6467,7 +6478,8 @@ To test whether a function can be called interactively, use `commandp'." ;; Kept around for now. See discussion at: ;; https://lists.gnu.org/r/emacs-devel/2020-08/msg00564.html - (declare (obsolete called-interactively-p "23.2") + (declare (type (function () boolean)) + (obsolete called-interactively-p "23.2") (side-effect-free error-free)) (called-interactively-p 'interactive)) diff --git a/lisp/window.el b/lisp/window.el index cdc6f690bab..639090752be 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -2515,7 +2515,8 @@ have special meanings: Any other value of ALL-FRAMES means consider all windows on the selected frame and no others." - (declare (side-effect-free error-free)) + (declare (type (function (&optional t t t) (or window null))) + (side-effect-free error-free)) (let ((windows (window-list-1 nil 'nomini all-frames)) best-window best-time second-best-window second-best-time time) (dolist (window windows) @@ -2594,7 +2595,8 @@ have special meanings: Any other value of ALL-FRAMES means consider all windows on the selected frame and no others." - (declare (side-effect-free error-free)) + (declare (type (function (&optional t t t) (or window null))) + (side-effect-free error-free)) (let ((best-size 0) best-window size) (dolist (window (window-list-1 nil 'nomini all-frames)) @@ -4089,7 +4091,8 @@ with a special meaning are: Anything else means consider all windows on the selected frame and no others." - (declare (side-effect-free error-free)) + (declare (type (function (&optional t t) boolean)) + (side-effect-free error-free)) (let ((base-window (selected-window))) (if (and nomini (eq base-window (minibuffer-window))) (setq base-window (next-window base-window))) commit d8c941df7d8167fdec8cad562c095e27203f7818 Author: Andrea Corallo Date: Fri Feb 23 15:56:47 2024 +0100 Make use of Lisp function declarations * lisp/emacs-lisp/comp.el (comp-primitive-func-cstr-h): Rename. (comp--get-function-cstr): Define new function. (comp--add-call-cstr, comp--fwprop-call): Update. * lisp/emacs-lisp/comp-common.el (comp-function-type-spec): Update. * lisp/help-fns.el (help-fns--signature): Mention when a type is declared. * lisp/emacs-lisp/comp.el (comp-primitive-func-cstr-h): Rename. diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index 62fd28f772e..cfaf843a3fd 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -532,22 +532,27 @@ Account for `native-comp-eln-load-path' and `comp-native-version-dir'." (defun comp-function-type-spec (function) "Return the type specifier of FUNCTION. -This function returns a cons cell whose car is the function -specifier, and cdr is a symbol, either `inferred' or `know'. -If the symbol is `inferred', the type specifier is automatically -inferred from the code itself by the native compiler; if it is -`know', the type specifier comes from `comp-known-type-specifiers'." - (let ((kind 'know) - type-spec ) +This function returns a cons cell whose car is the function specifier, +and cdr is a symbol, either `inferred' or `declared'. If the symbol is +`inferred', the type specifier is automatically inferred from the code +itself by the native compiler; if it is `declared', the type specifier +comes from `comp-known-type-specifiers' or the function type declaration +itself." + (let ((kind 'declared) + type-spec) (when-let ((res (assoc function comp-known-type-specifiers))) + ;; Declared primitive (setf type-spec (cadr res))) (let ((f (and (symbolp function) (symbol-function function)))) - (when (and f - (null type-spec) - (subr-native-elisp-p f)) - (setf kind 'inferred - type-spec (subr-type f)))) + (when (and f (null type-spec)) + (if-let ((delc-type (function-get function 'declared-type))) + ;; Declared Lisp function + (setf type-spec (car delc-type)) + (when (subr-native-elisp-p f) + ;; Native compiled inferred + (setf kind 'inferred + type-spec (subr-type f)))))) (when type-spec (cons type-spec kind)))) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2ec55ed98ee..a7d4c71dc26 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -179,16 +179,24 @@ For internal use by the test suite only.") Each function in FUNCTIONS is run after PASS. Useful to hook into pass checkers.") -(defconst comp-known-func-cstr-h +(defconst comp-primitive-func-cstr-h (cl-loop with comp-ctxt = (make-comp-cstr-ctxt) with h = (make-hash-table :test #'eq) - for (f type-spec) in comp-known-type-specifiers + for (f type-spec) in comp-primitive-type-specifiers for cstr = (comp-type-spec-to-cstr type-spec) do (puthash f cstr h) finally return h) "Hash table function -> `comp-constraint'.") +(defun comp--get-function-cstr (function) + "Given FUNCTION return the corresponding `comp-constraint'." + (when (symbolp function) + (let ((f (symbol-function function))) + (or (gethash f comp-primitive-func-cstr-h) + (when-let ((res (function-get function 'declared-type))) + (comp-type-spec-to-cstr (car res))))))) + ;; Keep it in sync with the `cl-deftype-satisfies' property set in ;; cl-macs.el. We can't use `cl-deftype-satisfies' directly as the ;; relation type <-> predicate is not bijective (bug#45576). @@ -2102,10 +2110,10 @@ TARGET-BB-SYM is the symbol name of the target block." (when-let ((match (pcase insn (`(set ,lhs (,(pred comp--call-op-p) ,f . ,args)) - (when-let ((cstr-f (gethash f comp-known-func-cstr-h))) + (when-let ((cstr-f (comp--get-function-cstr f))) (cl-values f cstr-f lhs args))) (`(,(pred comp--call-op-p) ,f . ,args) - (when-let ((cstr-f (gethash f comp-known-func-cstr-h))) + (when-let ((cstr-f (comp--get-function-cstr f))) (cl-values f cstr-f nil args)))))) (cl-multiple-value-bind (f cstr-f lhs args) match (cl-loop @@ -2642,7 +2650,7 @@ Fold the call in case." (comp-cstr-imm-vld-p (car args))) (setf f (comp-cstr-imm (car args)) args (cdr args))) - (when-let ((cstr-f (gethash f comp-known-func-cstr-h))) + (when-let ((cstr-f (comp--get-function-cstr f))) (let ((cstr (comp-cstr-f-ret cstr-f))) (when (comp-cstr-empty-p cstr) ;; Store it to be rewritten as non local exit. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index cfe27077055..26fe614ffb5 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -734,7 +734,7 @@ the C sources, too." (insert (format (if (eq kind 'inferred) "\nInferred type: %s\n" - "\nType: %s\n") + "\nDeclared type: %s\n") type-spec)))) (fill-region fill-begin (point)) high-doc))))) commit 1c7b8099839f62ddfaa5a0f87c29bcd905095dee Author: Andrea Corallo Date: Fri Feb 23 10:17:27 2024 +0100 * Add function type declarations for Lisp functions * lisp/emacs-lisp/byte-run.el (byte-run--set-declared-type): Add alias. (defun-declarations-alist): Use it for 'type' declaration. diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index cc176821026..88571593c31 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -217,6 +217,11 @@ So far, FUNCTION can only be a symbol, not a lambda expression." (cadr elem))) val))))) +(defalias 'byte-run--set-declared-type + #'(lambda (f _args &rest val) + (list 'function-put (list 'quote f) + ''declared-type (list 'quote val)))) + ;; Add any new entries to info node `(elisp)Declare Form'. (defvar defun-declarations-alist (list @@ -239,7 +244,8 @@ If `error-free', drop calls even if `byte-compile-delete-errors' is nil.") (list 'speed #'byte-run--set-speed) (list 'completion #'byte-run--set-completion) (list 'modes #'byte-run--set-modes) - (list 'interactive-args #'byte-run--set-interactive-args)) + (list 'interactive-args #'byte-run--set-interactive-args) + (list 'type #'byte-run--set-declared-type)) "List associating function properties to their macro expansion. Each element of the list takes the form (PROP FUN) where FUN is a function. For each (PROP . VALUES) in a function's declaration,