commit 599504a87daaaaa868ec3b1afa256e1b7ceee193 (HEAD, refs/remotes/origin/master) Author: Manuel Giraud Date: Wed May 22 21:53:47 2024 +0200 ; Fix typo in NEWS (bug#71130). diff --git a/etc/NEWS b/etc/NEWS index d72ef5b5bef..53119307f82 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -228,7 +228,7 @@ This is used for displaying the time and date components of --- ** New icon images for general use. Several symbolic icons are added to "etc/images/symbols", including -plus, minus, check-mark, start, etc. +plus, minus, check-mark, star, etc. +++ ** Tool bars can now be placed on the bottom on more systems. commit 5f3feb504c22296234eadb0a8534777514200bde Author: Eli Zaretskii Date: Wed May 22 21:43:43 2024 +0300 ; Fix recently-added documentation * doc/lispref/parsing.texi (Tree-sitter Major Modes): Mention 'treesit-indent-function'. (Bug#71086) diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 63551442b03..35ee5cc648d 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -2081,8 +2081,9 @@ If @code{treesit-font-lock-settings} (@pxref{Parser-based Font Lock}) is non-@code{nil}, it sets up fontification. @item -If @code{treesit-simple-indent-rules} (@pxref{Parser-based Indentation}) -is non-@code{nil}, it sets up indentation. +If either @code{treesit-simple-indent-rules} or +@code{treesit-indent-function} (@pxref{Parser-based Indentation}) is +non-@code{nil}, it sets up indentation. @item If @code{treesit-defun-type-regexp} is non-@code{nil}, it sets up commit d8af7c99bb0d98ab1b246cc5d8a1c5567c379d74 Author: Stefan Monnier Date: Wed May 22 13:27:50 2024 -0400 * lisp/emacs-lisp/pcase.el (pcase--subtype-bitsets): Fix bootstrap failure `rm lisp/emacs-lisp/cl-preloaded.elc src/bootstrap-emacs` followed by `make` ended up loading right after defining `built-in-class-p` but before actually defining the built-in-classes so the computation of bitsets failed. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 23f1bac600c..1a58c60734a 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -678,7 +678,8 @@ recording whether the var has been referenced by earlier parts of the match." bitsets))) (defconst pcase--subtype-bitsets - (if (fboundp 'built-in-class-p) + (if (and (fboundp 'built-in-class-p) + (built-in-class-p (get 'function 'cl--class))) (pcase--subtype-bitsets) ;; Early bootstrap: we don't have the built-in classes yet, so just ;; use an empty table for now. commit 70effed88df2e99287cfdabb924854f69ed668e2 Author: Po Lu Date: Wed May 22 22:00:02 2024 +0800 Improve compatibility with Android's default text editor * java/org/gnu/emacs/EmacsView.java (showOnScreenKeyboard): Request a selection update if `inputConnection' has been established, to more closely emulate the OS text editing widget. (onCreateInputConnection) [EmacsService.DEBUG_IC]: Print current selection values before reporting them. diff --git a/java/org/gnu/emacs/EmacsView.java b/java/org/gnu/emacs/EmacsView.java index 074e7242540..db270b796e8 100644 --- a/java/org/gnu/emacs/EmacsView.java +++ b/java/org/gnu/emacs/EmacsView.java @@ -45,6 +45,8 @@ import android.os.Build; import android.util.Log; +import java.util.Arrays; + /* This is an Android view which has a back and front buffer. When swapBuffers is called, the back buffer is swapped to the front buffer, and any damage is invalidated. frontBitmap and backBitmap @@ -775,6 +777,15 @@ else if (child.getVisibility () != GONE) imManager.showSoftInput (this, 0); isCurrentlyTextEditor = true; + + /* The OS text editing widget unconditionally reports the current + values of the selection to the input method after calls to + showSoftInput, which is redundant if inputConnection exists but + is now relied upon in such circumstances by the OS's default + input method, and must therefore be faithfully reproduced on our + part. */ + if (inputConnection != null) + EmacsNative.requestSelectionUpdate (window.handle); } public void @@ -831,6 +842,12 @@ else if (child.getVisibility () != GONE) selection = EmacsService.viewGetSelection (window.handle); + if (EmacsService.DEBUG_IC) + Log.d (TAG, ("onCreateInputConnection: " + + (selection != null + ? Arrays.toString (selection) + : "(unavailable)"))); + if (selection == null) { /* If the selection could not be obtained, return 0 by 0. commit 394aac7b187628303aa2b772b29ffb5718910f94 Author: Basil L. Contovounesios Date: Wed May 22 12:02:35 2024 +0200 ; Fix last tree-sitter changes in Elisp manual. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 361a5e37d02..cf67b319924 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -5185,12 +5185,11 @@ It is more convenient to use the simple indentation engine described below: then the major mode needs only write some indentation rules, and the engine takes care of the rest. -To enable the parser-based indentation engine, either set -@code{treesit-simple-indent-rules} or set -@code{treesit-indent-function}, then call -@code{treesit-major-mode-setup}. (All that -@code{treesit-major-mode-setup} does is setting the value of -@code{indent-line-function} to @code{treesit-indent} and +To enable the parser-based indentation engine, set either +@code{treesit-simple-indent-rules} or @code{treesit-indent-function}, +then call @code{treesit-major-mode-setup}. (All that +@code{treesit-major-mode-setup} does is set the value of +@code{indent-line-function} to @code{treesit-indent}, and @code{indent-region-function} to @code{treesit-indent-region}.) @defvar treesit-indent-function diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 6afdce37728..63551442b03 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1899,9 +1899,10 @@ directly translate into operations shown above. :host 'html '((style_element (raw_text) @@capture)))) @end group + @group ;; Major modes with multiple languages should always set -`treesit-language-at-point-function' (which see). +;; `treesit-language-at-point-function' (which see). (setq treesit-language-at-point-function (lambda (pos) (let* ((node (treesit-node-at pos 'html)) commit e153093f0a14fda47daa12b151b291e61d20b7e3 Author: Yuan Fu Date: Tue May 21 23:15:00 2024 -0700 Improve treesit-major-mode-setup indentation setup (bug#71086) * lisp/treesit.el (treesit-major-mode-setup): Setup indentation when treesit-indent-function is set. * doc/lispref/modes.texi (Parser-based Indentation): Fix manual. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index ffede9e86f5..361a5e37d02 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -5186,9 +5186,12 @@ below: then the major mode needs only write some indentation rules, and the engine takes care of the rest. To enable the parser-based indentation engine, either set -@code{treesit-simple-indent-rules} and call -@code{treesit-major-mode-setup}, or equivalently, set the value of -@code{indent-line-function} to @code{treesit-indent}. +@code{treesit-simple-indent-rules} or set +@code{treesit-indent-function}, then call +@code{treesit-major-mode-setup}. (All that +@code{treesit-major-mode-setup} does is setting the value of +@code{indent-line-function} to @code{treesit-indent} and +@code{indent-region-function} to @code{treesit-indent-region}.) @defvar treesit-indent-function This variable stores the actual function called by diff --git a/lisp/treesit.el b/lisp/treesit.el index 86ed1bbae33..0475227c726 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -3008,7 +3008,12 @@ before calling this function." (when treesit-simple-indent-rules (setq-local treesit-simple-indent-rules (treesit--indent-rules-optimize - treesit-simple-indent-rules)) + treesit-simple-indent-rules))) + ;; Enable indent if simple indent rules are set, or the major mode + ;; sets a custom indent function. + (when (or treesit-simple-indent-rules + (and (not (eq treesit-indent-function #'treesit-simple-indent)) + treesit-indent-function)) (setq-local indent-line-function #'treesit-indent) (setq-local indent-region-function #'treesit-indent-region)) ;; Navigation. commit 45ba332addec3be7c4c15917c25c59c64c0633c4 Author: Yuan Fu Date: Tue May 21 23:01:33 2024 -0700 Fontify namespace in constant face in c++-ts-mode (bug#71070) * lisp/progmodes/c-ts-mode.el (c-ts-mode--font-lock-settings): Use constant face. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index b703999d788..f453392ff7f 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -663,7 +663,7 @@ MODE is either `c' or `cpp'." '((type_qualifier) @font-lock-type-face (qualified_identifier - scope: (namespace_identifier) @font-lock-type-face) + scope: (namespace_identifier) @font-lock-constant-face) (operator_cast) type: (type_identifier) @font-lock-type-face commit e947e63b066680bbc7e027f73c9e68e26a47d0dd Author: Yuan Fu Date: Tue May 21 22:40:32 2024 -0700 Address a common pitfall in tree-sitter's manual section (bug#71048) * doc/lispref/parsing.texi (Multiple Languages): Add example for treesit-language-at-point-function. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 1bc0acfacd0..6afdce37728 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1894,12 +1894,29 @@ directly translate into operations shown above. :host 'html '((script_element (raw_text) @@capture)) @end group - @group :embed 'css :host 'html '((style_element (raw_text) @@capture)))) @end group +@group +;; Major modes with multiple languages should always set +`treesit-language-at-point-function' (which see). +(setq treesit-language-at-point-function + (lambda (pos) + (let* ((node (treesit-node-at pos 'html)) + (parent (treesit-node-parent node))) + (cond + ((and node parent + (equal (treesit-node-type node) "raw_text") + (equal (treesit-node-type parent) "script_element")) + 'javascript) + ((and node parent + (equal (treesit-node-type node) "raw_text") + (equal (treesit-node-type parent) "style_element")) + 'css) + (t 'html))))) +@end group @end example @defun treesit-range-rules &rest query-specs commit 63d914e377f7cc37056de2503bfbeea831875037 Author: Dmitry Gutov Date: Wed May 22 02:51:51 2024 +0300 etags-regen-program: Use more robust default value * lisp/progmodes/etags-regen.el (etags-regen-program): Default to the value of the variable etags-program-name. diff --git a/lisp/progmodes/etags-regen.el b/lisp/progmodes/etags-regen.el index 02d666ceff7..dc778b14061 100644 --- a/lisp/progmodes/etags-regen.el +++ b/lisp/progmodes/etags-regen.el @@ -1,6 +1,6 @@ ;;; etags-regen.el --- Auto-(re)regenerating tags -*- lexical-binding: t -*- -;; Copyright (C) 2021-2023 Free Software Foundation, Inc. +;; Copyright (C) 2021-2024 Free Software Foundation, Inc. ;; Author: Dmitry Gutov ;; Keywords: tools @@ -52,7 +52,7 @@ (declare-function project-files "project") (declare-function dired-glob-regexp "dired") -(defcustom etags-regen-program (executable-find "etags") +(defcustom etags-regen-program etags-program-name "Name of the etags program used by `etags-regen-mode'. If you only have `ctags' installed, you can also set this to commit ce8e292bca84f29cea540e3e23e88ec7a5d1674e Author: Juri Linkov Date: Tue May 21 20:22:31 2024 +0300 Use read-from-minibuffer instead of read-string for dired-do-touch * lisp/dired-aux.el (dired-mark-read-string): Use read-from-minibuffer instead of read-string when op-symbol is 'touch', since it's more clear when read-from-minibuffer returns an empty string for RET, and it was used in dired-mark-read-string initially (bug#70725). diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index b5eea4c74f6..22c6881ae35 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -660,10 +660,10 @@ Optional arg COLLECTION is a collection of possible completions, passed as the second arg to `completing-read'." (apply #'dired-mark-pop-up nil op-symbol files - (if (eq op-symbol 'touch) 'read-string 'completing-read) + (if (eq op-symbol 'touch) 'read-from-minibuffer 'completing-read) (format prompt (dired-mark-prompt arg files)) (if (eq op-symbol 'touch) - `(,initial nil ,default-value nil) + `(,initial nil nil nil ,default-value) `(,collection nil nil ,initial nil ,default-value nil)))) commit 9aeb4872d473695b75a27184b7e90868c15242c9 Author: Michael Albinus Date: Tue May 21 18:13:40 2024 +0200 Fix some Tramp oddities * lisp/net/tramp-container.el: Move connection-local settings where they belong to. * lisp/net/tramp-sshfs.el (tramp-connection-properties): Do not set connection property "direct-async-process". (tramp-direct-async-process): Set connection-local value. * test/lisp/net/tramp-tests.el (comp-warn-primitives): Declare. (tramp-test18-file-attributes): Use it. diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 3d15d71d709..2886e25d16b 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -554,7 +554,25 @@ see its function help for a description of the format." (tramp-set-completion-function tramp-kubernetes-method - `((tramp-kubernetes--completion-function ,tramp-kubernetes-method)))) + `((tramp-kubernetes--completion-function ,tramp-kubernetes-method))) + + (defconst tramp-kubernetes-connection-local-default-variables + '((tramp-config-check . tramp-kubernetes--current-context-data) + ;; This variable will be eval'ed in `tramp-expand-args'. + (tramp-extra-expand-args + . (?a (tramp-kubernetes--container (car tramp-current-connection)) + ?h (tramp-kubernetes--pod (car tramp-current-connection)) + ?x (tramp-kubernetes--context-namespace + (car tramp-current-connection))))) + "Default connection-local variables for remote kubernetes connections.") + + (connection-local-set-profile-variables + 'tramp-kubernetes-connection-local-default-profile + tramp-kubernetes-connection-local-default-variables) + + (connection-local-set-profiles + `(:application tramp :protocol ,tramp-kubernetes-method) + 'tramp-kubernetes-connection-local-default-profile)) ;;;###tramp-autoload (defun tramp-enable-toolbox-method () @@ -595,7 +613,19 @@ see its function help for a description of the format." (tramp-set-completion-function tramp-flatpak-method - `((tramp-flatpak--completion-function ,tramp-flatpak-method)))) + `((tramp-flatpak--completion-function ,tramp-flatpak-method))) + + (defconst tramp-flatpak-connection-local-default-variables + `((tramp-remote-path . ,(cons "/app/bin" tramp-remote-path))) + "Default connection-local variables for remote flatpak connections.") + + (connection-local-set-profile-variables + 'tramp-flatpak-connection-local-default-profile + tramp-flatpak-connection-local-default-variables) + + (connection-local-set-profiles + `(:application tramp :protocol ,tramp-flatpak-method) + 'tramp-flatpak-connection-local-default-profile)) ;;;###tramp-autoload (defun tramp-enable-apptainer-method () @@ -638,38 +668,6 @@ see its function help for a description of the format." tramp-nspawn-method `((tramp-nspawn--completion-function ,tramp-nspawn-method)))) -;; Default connection-local variables for Tramp. - -(defconst tramp-kubernetes-connection-local-default-variables - '((tramp-config-check . tramp-kubernetes--current-context-data) - ;; This variable will be eval'ed in `tramp-expand-args'. - (tramp-extra-expand-args - . (?a (tramp-kubernetes--container (car tramp-current-connection)) - ?h (tramp-kubernetes--pod (car tramp-current-connection)) - ?x (tramp-kubernetes--context-namespace - (car tramp-current-connection))))) - "Default connection-local variables for remote kubernetes connections.") - -(connection-local-set-profile-variables - 'tramp-kubernetes-connection-local-default-profile - tramp-kubernetes-connection-local-default-variables) - -(connection-local-set-profiles - `(:application tramp :protocol ,tramp-kubernetes-method) - 'tramp-kubernetes-connection-local-default-profile) - -(defconst tramp-flatpak-connection-local-default-variables - `((tramp-remote-path . ,(cons "/app/bin" tramp-remote-path))) - "Default connection-local variables for remote flatpak connections.") - -(connection-local-set-profile-variables - 'tramp-flatpak-connection-local-default-profile - tramp-flatpak-connection-local-default-variables) - -(connection-local-set-profiles - `(:application tramp :protocol ,tramp-flatpak-method) - 'tramp-flatpak-connection-local-default-profile) - (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-container 'force))) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index d0d56b8967e..218cf30dea5 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -67,9 +67,6 @@ (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")))) - (add-to-list 'tramp-connection-properties - `(,(format "/%s:" tramp-sshfs-method) "direct-async-process" t)) - (tramp-set-completion-function tramp-sshfs-method tramp-completion-function-alist-ssh)) @@ -445,6 +442,16 @@ connection if a previous connection has died for some reason." (with-tramp-connection-property vec "gid-string" (tramp-get-local-gid 'string)))) +;; Default connection-local variables for Tramp. + +(connection-local-set-profile-variables + 'tramp-sshfs-connection-local-default-profile + '((tramp-direct-async-process t))) + +(connection-local-set-profiles + `(:application tramp :protocol ,tramp-sshfs-method) + 'tramp-sshfs-connection-local-default-profile) + ;; `shell-mode' tries to open remote files like "/sshfs:user@host:~/.history". ;; This fails, because the tilde cannot be expanded. Tell ;; `tramp-handle-expand-file-name' to tolerate this. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 366082edb75..130f4a76ff5 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -64,6 +64,7 @@ (declare-function tramp-method-out-of-band-p "tramp-sh") (declare-function tramp-smb-get-localname "tramp-smb") (defvar ange-ftp-make-backup-files) +(defvar comp-warn-primitives) (defvar tramp-connection-properties) (defvar tramp-copy-size-limit) (defvar tramp-fuse-remove-hidden-files) @@ -3689,7 +3690,8 @@ This tests also `access-file', `file-readable-p', ;; `access-file' returns nil in case of success. (should-not (access-file tmp-name1 "error")) ;; `access-file' could use a timeout. - (let ((remote-file-name-access-timeout 1)) + (let ((remote-file-name-access-timeout 1) + comp-warn-primitives) (cl-letf (((symbol-function #'file-exists-p) (lambda (_filename) (sleep-for 5)))) (should-error commit c8b34046d93ab28b3e56aa04ce4526b4c76d5581 Author: Stephen Berman Date: Tue May 21 15:04:43 2024 +0200 ; Avoid byte-compiler warning in todo-mode.el differently * lisp/calendar/todo-mode.el (todo-mode-map): Define it without a value before its use in 'todo-insert-item--next-param' to pacify the byte-compiler. (todo-insert-item--next-param): Move back to its previous location to keep it under the outline heading with related code. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index b9118e86c3b..77f0ee7e565 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -5702,6 +5702,155 @@ of each other." Passed by `todo-insert-item' to `todo-insert-item--next-param' to dynamically create item insertion commands.") +;; As the following function uses this variable, define it here without +;; a value to avoid a byte-compiler warning. The real definition with +;; value is provided below with the other todo-mode key bindings. +(defvar todo-mode-map) + +(defun todo-insert-item--next-param (args params last keys-so-far) + "Generate and invoke an item insertion command. +Dynamically generate the command, its arguments ARGS and its key +binding by recursing through the list of parameters PARAMS, +taking the LAST from a sublist and prompting with KEYS-SO-FAR +keys already entered and those still available." + (cl-assert params) + (let* ((map (make-sparse-keymap)) + (param-key-alist '((default . "i") + (copy . "p") + (diary . "y") + (nonmarking . "k") + (calendar . "c") + (date . "d") + (dayname . "n") + (time . "t") + (here . "h") + (region . "r"))) + ;; Return key paired with given item insertion parameter. + (key-of (lambda (param) (cdr (assoc param param-key-alist)))) + ;; The key just typed. + (this-key (lambda () (char-to-string last-command-event))) + (prompt nil) + ;; Add successively entered keys to the prompt and show what + ;; possibilities remain. + (add-to-prompt + (lambda (key name) + (setq prompt + (concat prompt + (format + (concat + (if (memq name '(default diary calendar here)) + " { " " ") + "%s=>%s" + (when (memq name '(copy nonmarking dayname region)) + " }")) + (propertize key 'face 'todo-key-prompt) + name))))) + ;; Return the sublist of the given list of parameters whose + ;; first member is paired with the given key. + (get-params + (lambda (key lst) + (setq lst (if (consp lst) lst (list lst))) + (let (l sym) + (mapc (lambda (m) + (when (consp m) + (catch 'found1 + (dolist (s m) + (when (equal key (funcall key-of s)) + (throw 'found1 (setq sym s)))))) + (if sym + (progn + (push sym l) + (setq sym nil)) + (push m l))) + lst) + (setq lst (reverse l))) + (memq (catch 'found2 + (dolist (e param-key-alist) + (when (equal key (cdr e)) + (throw 'found2 (car e))))) + lst))) + ;; Build list of arguments for item insertion and then + ;; execute the basic insertion function. The list consists of + ;; item insertion parameters that can be passed as insertion + ;; command arguments in fixed positions. If a position in + ;; the list is not occupied by the corresponding parameter, + ;; it is occupied by nil. + (gen-and-exec + (lambda () + (let* ((arg (list (car args))) ; Possible prefix argument. + (rest (nconc (cdr args) + (list (car (funcall get-params + (funcall this-key) + params))))) + (parlist (if (= 4 (length rest)) + rest + (let ((v (make-vector 4 nil)) elt) + (while rest + (setq elt (pop rest)) + (cond ((memq elt '(diary nonmarking)) + (aset v 0 elt)) + ((memq elt '(calendar date dayname)) + (aset v 1 elt)) + ((eq elt 'time) + (aset v 2 elt)) + ((memq elt '(copy here region)) + (aset v 3 elt)))) + (append v nil))))) + (apply #'todo-insert-item--basic (nconc arg parlist))))) + ;; Operate on a copy of the parameter list so the original is + ;; not consumed, thus available for the next key typed. + (params0 params) + (tm-keys (let (l) + (map-keymap (lambda (key _binding) + (push key l)) + todo-mode-map) + l))) + ;; Initially assign each key in todo-mode-map a function identifying + ;; it as invalid for item insertion, thus preventing mistakenly + ;; pressing a key from executing an unwanted different todo-mode + ;; command (bug#70937); the actual item insertion keys are redefined + ;; when looping over the item insertion parameters. + (dolist (k tm-keys) + (when (characterp k) + (define-key map (string k) + (lambda () + (interactive) + (message (concat "`%s' is not a valid remaining item insertion key") + (string k)))))) + (when last + (if (memq last '(default copy)) + (progn + (setq params0 nil) + (funcall gen-and-exec)) + (let ((key (funcall key-of last))) + (funcall add-to-prompt key (make-symbol + (concat (symbol-name last) ":GO!"))) + (define-key map (funcall key-of last) + (lambda () (interactive) + (funcall gen-and-exec)))))) + (while params0 + (let* ((x (car params0)) + (restparams (cdr params0))) + (dolist (param (if (consp x) x (list x))) + (let ((key (funcall key-of param))) + (funcall add-to-prompt key param) + (define-key map key + (if (null restparams) + (lambda () (interactive) + (funcall gen-and-exec)) + (lambda () (interactive) + (setq keys-so-far (concat keys-so-far " " (funcall this-key))) + (todo-insert-item--next-param + (nconc args (list (car (funcall get-params + (funcall this-key) param)))) + (cdr (funcall get-params (funcall this-key) params)) + (car (funcall get-params (funcall this-key) param)) + keys-so-far)))))) + (setq params0 restparams))) + (set-transient-map map) + (when prompt (message "Press a key (so far `%s'): %s" keys-so-far prompt)) + (setq params0 params))) + (defun todo-edit-item--next-key (type &optional arg) (let* ((todo-param-key-alist '((edit . "e") (header . "h") @@ -6626,150 +6775,6 @@ Filtered Items mode following todo (not done) items." ["Quit Todo Mode" todo-quit t] )) -(defun todo-insert-item--next-param (args params last keys-so-far) - "Generate and invoke an item insertion command. -Dynamically generate the command, its arguments ARGS and its key -binding by recursing through the list of parameters PARAMS, -taking the LAST from a sublist and prompting with KEYS-SO-FAR -keys already entered and those still available." - (cl-assert params) - (let* ((map (make-sparse-keymap)) - (param-key-alist '((default . "i") - (copy . "p") - (diary . "y") - (nonmarking . "k") - (calendar . "c") - (date . "d") - (dayname . "n") - (time . "t") - (here . "h") - (region . "r"))) - ;; Return key paired with given item insertion parameter. - (key-of (lambda (param) (cdr (assoc param param-key-alist)))) - ;; The key just typed. - (this-key (lambda () (char-to-string last-command-event))) - (prompt nil) - ;; Add successively entered keys to the prompt and show what - ;; possibilities remain. - (add-to-prompt - (lambda (key name) - (setq prompt - (concat prompt - (format - (concat - (if (memq name '(default diary calendar here)) - " { " " ") - "%s=>%s" - (when (memq name '(copy nonmarking dayname region)) - " }")) - (propertize key 'face 'todo-key-prompt) - name))))) - ;; Return the sublist of the given list of parameters whose - ;; first member is paired with the given key. - (get-params - (lambda (key lst) - (setq lst (if (consp lst) lst (list lst))) - (let (l sym) - (mapc (lambda (m) - (when (consp m) - (catch 'found1 - (dolist (s m) - (when (equal key (funcall key-of s)) - (throw 'found1 (setq sym s)))))) - (if sym - (progn - (push sym l) - (setq sym nil)) - (push m l))) - lst) - (setq lst (reverse l))) - (memq (catch 'found2 - (dolist (e param-key-alist) - (when (equal key (cdr e)) - (throw 'found2 (car e))))) - lst))) - ;; Build list of arguments for item insertion and then - ;; execute the basic insertion function. The list consists of - ;; item insertion parameters that can be passed as insertion - ;; command arguments in fixed positions. If a position in - ;; the list is not occupied by the corresponding parameter, - ;; it is occupied by nil. - (gen-and-exec - (lambda () - (let* ((arg (list (car args))) ; Possible prefix argument. - (rest (nconc (cdr args) - (list (car (funcall get-params - (funcall this-key) - params))))) - (parlist (if (= 4 (length rest)) - rest - (let ((v (make-vector 4 nil)) elt) - (while rest - (setq elt (pop rest)) - (cond ((memq elt '(diary nonmarking)) - (aset v 0 elt)) - ((memq elt '(calendar date dayname)) - (aset v 1 elt)) - ((eq elt 'time) - (aset v 2 elt)) - ((memq elt '(copy here region)) - (aset v 3 elt)))) - (append v nil))))) - (apply #'todo-insert-item--basic (nconc arg parlist))))) - ;; Operate on a copy of the parameter list so the original is - ;; not consumed, thus available for the next key typed. - (params0 params) - (tm-keys (let (l) - (map-keymap (lambda (key _binding) - (push key l)) - todo-mode-map) - l))) - ;; Initially assign each key in todo-mode-map a function identifying - ;; it as invalid for item insertion, thus preventing mistakenly - ;; pressing a key from executing an unwanted different todo-mode - ;; command (bug#70937); the actual item insertion keys are redefined - ;; when looping over the item insertion parameters. - (dolist (k tm-keys) - (when (characterp k) - (define-key map (string k) - (lambda () - (interactive) - (message (concat "`%s' is not a valid remaining item insertion key") - (string k)))))) - (when last - (if (memq last '(default copy)) - (progn - (setq params0 nil) - (funcall gen-and-exec)) - (let ((key (funcall key-of last))) - (funcall add-to-prompt key (make-symbol - (concat (symbol-name last) ":GO!"))) - (define-key map (funcall key-of last) - (lambda () (interactive) - (funcall gen-and-exec)))))) - (while params0 - (let* ((x (car params0)) - (restparams (cdr params0))) - (dolist (param (if (consp x) x (list x))) - (let ((key (funcall key-of param))) - (funcall add-to-prompt key param) - (define-key map key - (if (null restparams) - (lambda () (interactive) - (funcall gen-and-exec)) - (lambda () (interactive) - (setq keys-so-far (concat keys-so-far " " (funcall this-key))) - (todo-insert-item--next-param - (nconc args (list (car (funcall get-params - (funcall this-key) param)))) - (cdr (funcall get-params (funcall this-key) params)) - (car (funcall get-params (funcall this-key) param)) - keys-so-far)))))) - (setq params0 restparams))) - (set-transient-map map) - (when prompt (message "Press a key (so far `%s'): %s" keys-so-far prompt)) - (setq params0 params))) - ;; ----------------------------------------------------------------------------- ;;; Hook functions and mode definitions ;; ----------------------------------------------------------------------------- commit 003eddc1dc31a8b3c8ab2c0d7a8d05dcb83487b2 Author: Eli Zaretskii Date: Tue May 21 14:17:24 2024 +0300 ; Avoid byte-compiler warning in todo-mode.el * lisp/calendar/todo-mode.el (todo-insert-item--next-param): Move to after the definition of 'todo-mode-map', which this function uses. This avoids byte-compiler warning. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 76fd4f497a4..b9118e86c3b 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -5702,150 +5702,6 @@ of each other." Passed by `todo-insert-item' to `todo-insert-item--next-param' to dynamically create item insertion commands.") -(defun todo-insert-item--next-param (args params last keys-so-far) - "Generate and invoke an item insertion command. -Dynamically generate the command, its arguments ARGS and its key -binding by recursing through the list of parameters PARAMS, -taking the LAST from a sublist and prompting with KEYS-SO-FAR -keys already entered and those still available." - (cl-assert params) - (let* ((map (make-sparse-keymap)) - (param-key-alist '((default . "i") - (copy . "p") - (diary . "y") - (nonmarking . "k") - (calendar . "c") - (date . "d") - (dayname . "n") - (time . "t") - (here . "h") - (region . "r"))) - ;; Return key paired with given item insertion parameter. - (key-of (lambda (param) (cdr (assoc param param-key-alist)))) - ;; The key just typed. - (this-key (lambda () (char-to-string last-command-event))) - (prompt nil) - ;; Add successively entered keys to the prompt and show what - ;; possibilities remain. - (add-to-prompt - (lambda (key name) - (setq prompt - (concat prompt - (format - (concat - (if (memq name '(default diary calendar here)) - " { " " ") - "%s=>%s" - (when (memq name '(copy nonmarking dayname region)) - " }")) - (propertize key 'face 'todo-key-prompt) - name))))) - ;; Return the sublist of the given list of parameters whose - ;; first member is paired with the given key. - (get-params - (lambda (key lst) - (setq lst (if (consp lst) lst (list lst))) - (let (l sym) - (mapc (lambda (m) - (when (consp m) - (catch 'found1 - (dolist (s m) - (when (equal key (funcall key-of s)) - (throw 'found1 (setq sym s)))))) - (if sym - (progn - (push sym l) - (setq sym nil)) - (push m l))) - lst) - (setq lst (reverse l))) - (memq (catch 'found2 - (dolist (e param-key-alist) - (when (equal key (cdr e)) - (throw 'found2 (car e))))) - lst))) - ;; Build list of arguments for item insertion and then - ;; execute the basic insertion function. The list consists of - ;; item insertion parameters that can be passed as insertion - ;; command arguments in fixed positions. If a position in - ;; the list is not occupied by the corresponding parameter, - ;; it is occupied by nil. - (gen-and-exec - (lambda () - (let* ((arg (list (car args))) ; Possible prefix argument. - (rest (nconc (cdr args) - (list (car (funcall get-params - (funcall this-key) - params))))) - (parlist (if (= 4 (length rest)) - rest - (let ((v (make-vector 4 nil)) elt) - (while rest - (setq elt (pop rest)) - (cond ((memq elt '(diary nonmarking)) - (aset v 0 elt)) - ((memq elt '(calendar date dayname)) - (aset v 1 elt)) - ((eq elt 'time) - (aset v 2 elt)) - ((memq elt '(copy here region)) - (aset v 3 elt)))) - (append v nil))))) - (apply #'todo-insert-item--basic (nconc arg parlist))))) - ;; Operate on a copy of the parameter list so the original is - ;; not consumed, thus available for the next key typed. - (params0 params) - (tm-keys (let (l) - (map-keymap (lambda (key _binding) - (push key l)) - todo-mode-map) - l))) - ;; Initially assign each key in todo-mode-map a function identifying - ;; it as invalid for item insertion, thus preventing mistakenly - ;; pressing a key from executing an unwanted different todo-mode - ;; command (bug#70937); the actual item insertion keys are redefined - ;; when looping over the item insertion parameters. - (dolist (k tm-keys) - (when (characterp k) - (define-key map (string k) - (lambda () - (interactive) - (message (concat "`%s' is not a valid remaining item insertion key") - (string k)))))) - (when last - (if (memq last '(default copy)) - (progn - (setq params0 nil) - (funcall gen-and-exec)) - (let ((key (funcall key-of last))) - (funcall add-to-prompt key (make-symbol - (concat (symbol-name last) ":GO!"))) - (define-key map (funcall key-of last) - (lambda () (interactive) - (funcall gen-and-exec)))))) - (while params0 - (let* ((x (car params0)) - (restparams (cdr params0))) - (dolist (param (if (consp x) x (list x))) - (let ((key (funcall key-of param))) - (funcall add-to-prompt key param) - (define-key map key - (if (null restparams) - (lambda () (interactive) - (funcall gen-and-exec)) - (lambda () (interactive) - (setq keys-so-far (concat keys-so-far " " (funcall this-key))) - (todo-insert-item--next-param - (nconc args (list (car (funcall get-params - (funcall this-key) param)))) - (cdr (funcall get-params (funcall this-key) params)) - (car (funcall get-params (funcall this-key) param)) - keys-so-far)))))) - (setq params0 restparams))) - (set-transient-map map) - (when prompt (message "Press a key (so far `%s'): %s" keys-so-far prompt)) - (setq params0 params))) - (defun todo-edit-item--next-key (type &optional arg) (let* ((todo-param-key-alist '((edit . "e") (header . "h") @@ -6770,6 +6626,150 @@ Filtered Items mode following todo (not done) items." ["Quit Todo Mode" todo-quit t] )) +(defun todo-insert-item--next-param (args params last keys-so-far) + "Generate and invoke an item insertion command. +Dynamically generate the command, its arguments ARGS and its key +binding by recursing through the list of parameters PARAMS, +taking the LAST from a sublist and prompting with KEYS-SO-FAR +keys already entered and those still available." + (cl-assert params) + (let* ((map (make-sparse-keymap)) + (param-key-alist '((default . "i") + (copy . "p") + (diary . "y") + (nonmarking . "k") + (calendar . "c") + (date . "d") + (dayname . "n") + (time . "t") + (here . "h") + (region . "r"))) + ;; Return key paired with given item insertion parameter. + (key-of (lambda (param) (cdr (assoc param param-key-alist)))) + ;; The key just typed. + (this-key (lambda () (char-to-string last-command-event))) + (prompt nil) + ;; Add successively entered keys to the prompt and show what + ;; possibilities remain. + (add-to-prompt + (lambda (key name) + (setq prompt + (concat prompt + (format + (concat + (if (memq name '(default diary calendar here)) + " { " " ") + "%s=>%s" + (when (memq name '(copy nonmarking dayname region)) + " }")) + (propertize key 'face 'todo-key-prompt) + name))))) + ;; Return the sublist of the given list of parameters whose + ;; first member is paired with the given key. + (get-params + (lambda (key lst) + (setq lst (if (consp lst) lst (list lst))) + (let (l sym) + (mapc (lambda (m) + (when (consp m) + (catch 'found1 + (dolist (s m) + (when (equal key (funcall key-of s)) + (throw 'found1 (setq sym s)))))) + (if sym + (progn + (push sym l) + (setq sym nil)) + (push m l))) + lst) + (setq lst (reverse l))) + (memq (catch 'found2 + (dolist (e param-key-alist) + (when (equal key (cdr e)) + (throw 'found2 (car e))))) + lst))) + ;; Build list of arguments for item insertion and then + ;; execute the basic insertion function. The list consists of + ;; item insertion parameters that can be passed as insertion + ;; command arguments in fixed positions. If a position in + ;; the list is not occupied by the corresponding parameter, + ;; it is occupied by nil. + (gen-and-exec + (lambda () + (let* ((arg (list (car args))) ; Possible prefix argument. + (rest (nconc (cdr args) + (list (car (funcall get-params + (funcall this-key) + params))))) + (parlist (if (= 4 (length rest)) + rest + (let ((v (make-vector 4 nil)) elt) + (while rest + (setq elt (pop rest)) + (cond ((memq elt '(diary nonmarking)) + (aset v 0 elt)) + ((memq elt '(calendar date dayname)) + (aset v 1 elt)) + ((eq elt 'time) + (aset v 2 elt)) + ((memq elt '(copy here region)) + (aset v 3 elt)))) + (append v nil))))) + (apply #'todo-insert-item--basic (nconc arg parlist))))) + ;; Operate on a copy of the parameter list so the original is + ;; not consumed, thus available for the next key typed. + (params0 params) + (tm-keys (let (l) + (map-keymap (lambda (key _binding) + (push key l)) + todo-mode-map) + l))) + ;; Initially assign each key in todo-mode-map a function identifying + ;; it as invalid for item insertion, thus preventing mistakenly + ;; pressing a key from executing an unwanted different todo-mode + ;; command (bug#70937); the actual item insertion keys are redefined + ;; when looping over the item insertion parameters. + (dolist (k tm-keys) + (when (characterp k) + (define-key map (string k) + (lambda () + (interactive) + (message (concat "`%s' is not a valid remaining item insertion key") + (string k)))))) + (when last + (if (memq last '(default copy)) + (progn + (setq params0 nil) + (funcall gen-and-exec)) + (let ((key (funcall key-of last))) + (funcall add-to-prompt key (make-symbol + (concat (symbol-name last) ":GO!"))) + (define-key map (funcall key-of last) + (lambda () (interactive) + (funcall gen-and-exec)))))) + (while params0 + (let* ((x (car params0)) + (restparams (cdr params0))) + (dolist (param (if (consp x) x (list x))) + (let ((key (funcall key-of param))) + (funcall add-to-prompt key param) + (define-key map key + (if (null restparams) + (lambda () (interactive) + (funcall gen-and-exec)) + (lambda () (interactive) + (setq keys-so-far (concat keys-so-far " " (funcall this-key))) + (todo-insert-item--next-param + (nconc args (list (car (funcall get-params + (funcall this-key) param)))) + (cdr (funcall get-params (funcall this-key) params)) + (car (funcall get-params (funcall this-key) param)) + keys-so-far)))))) + (setq params0 restparams))) + (set-transient-map map) + (when prompt (message "Press a key (so far `%s'): %s" keys-so-far prompt)) + (setq params0 params))) + ;; ----------------------------------------------------------------------------- ;;; Hook functions and mode definitions ;; ----------------------------------------------------------------------------- commit 7f80070232a5c010ae18de9fd8803a66623c074b Author: Stephen Berman Date: Tue May 21 11:04:17 2024 +0200 Fix todo-mode item insertion bug (bug#70937) * lisp/calendar/todo-mode.el (todo-insert-item--next-param): Initially assign each key in todo-mode-map a function identifying it as invalid for item insertion, thus preventing mistakenly pressing a key from executing an unwanted different todo-mode command; the actual item insertion keys are redefined when looping over the item insertion parameters. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 12287299a7f..76fd4f497a4 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -5794,7 +5794,24 @@ keys already entered and those still available." (apply #'todo-insert-item--basic (nconc arg parlist))))) ;; Operate on a copy of the parameter list so the original is ;; not consumed, thus available for the next key typed. - (params0 params)) + (params0 params) + (tm-keys (let (l) + (map-keymap (lambda (key _binding) + (push key l)) + todo-mode-map) + l))) + ;; Initially assign each key in todo-mode-map a function identifying + ;; it as invalid for item insertion, thus preventing mistakenly + ;; pressing a key from executing an unwanted different todo-mode + ;; command (bug#70937); the actual item insertion keys are redefined + ;; when looping over the item insertion parameters. + (dolist (k tm-keys) + (when (characterp k) + (define-key map (string k) + (lambda () + (interactive) + (message (concat "`%s' is not a valid remaining item insertion key") + (string k)))))) (when last (if (memq last '(default copy)) (progn