From 2e73dec15f2555128c370ba48a077f1a178b2731 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 8 Mar 2023 15:08:00 -0500 Subject: [PATCH 1/3] gud.el: Fix bug#62041 Add a new `gud-shared-mode-map` where we put the bindings shared between `gud-minor-mode-map` and `gud-mode-map`. * lisp/progmodes/gud.el (gud-shared-mode-map): New keymap. (gud-mode-map, gud-minor-mode-map): Use it as parent. (gud-menu-map): Put the menu in that new keymap. (gud-speedbar-buttons, gdb-script-font-lock-syntactic-face) (gdb-script-indent-line): Skip obsolete face variables. --- lisp/progmodes/gud.el | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 92e018aaec1..cfe5f75d19f 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -135,9 +135,9 @@ Used to gray out relevant toolbar icons.") (defun gud-goto-info () "Go to relevant Emacs info node." (interactive) - (if (eq gud-minor-mode 'gdbmi) - (info-other-window "(emacs)GDB Graphical Interface") - (info-other-window "(emacs)Debuggers"))) + (info-other-window (if (eq gud-minor-mode 'gdbmi) + "(emacs)GDB Graphical Interface" + "(emacs)Debuggers"))) (defun gud-tool-bar-item-visible-no-fringe () (not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode) @@ -159,14 +159,17 @@ Used to gray out relevant toolbar icons.") (t (comint-interrupt-subjob))))) +(defvar-keymap gud-shared-mode-map + :doc "Keymap shared between `gud-mode' and `gud-minor-mode'.") + (defvar-keymap gud-mode-map - ;; Will inherit from comint-mode via define-derived-mode. - :doc "`gud-mode' keymap.") + :doc "`gud-mode' keymap." + :parent (make-composed-keymap gud-shared-mode-map comint-mode-map)) (defvar-keymap gud-minor-mode-map - :parent gud-mode-map) + :parent gud-shared-mode-map) -(easy-menu-define gud-menu-map gud-mode-map +(easy-menu-define gud-menu-map gud-shared-mode-map "Menu for `gud-mode'." '("Gud" ["Continue" gud-cont @@ -535,9 +538,9 @@ required by the caller." (value (nth 4 var)) (status (nth 5 var)) (has-more (nth 6 var))) (put-text-property - 0 (length expr) 'face font-lock-variable-name-face expr) + 0 (length expr) 'face 'font-lock-variable-name-face expr) (put-text-property - 0 (length type) 'face font-lock-type-face type) + 0 (length type) 'face 'font-lock-type-face type) (while (string-match "\\." varnum start) (setq depth (1+ depth) start (1+ (match-beginning 0)))) @@ -1260,7 +1263,7 @@ whereby $stopformat=1 produces an output format compatible with (define-key map key cmd)) (when (or gud-mips-p gud-irix-p) - (define-key map "f" 'gud-finish)) + (define-key map "f" #'gud-finish)) map) "Keymap to repeat `dbx' stepping instructions \\`C-x C-a C-n n n'. Used in `repeat-mode'.") @@ -3422,9 +3425,9 @@ class of the file (using s to separate nested class ids)." (defun gdb-script-font-lock-syntactic-face (state) (cond - ((nth 3 state) font-lock-string-face) - ((nth 7 state) font-lock-doc-face) - (t font-lock-comment-face))) + ((nth 3 state) 'font-lock-string-face) + ((nth 7 state) 'font-lock-doc-face) + (t 'font-lock-comment-face))) (defvar gdb-script-basic-indent 2) @@ -3455,7 +3458,7 @@ class of the file (using s to separate nested class ids)." (defun gdb-script-indent-line () "Indent current line of GDB script." (interactive) - (if (and (eq (get-text-property (point) 'face) font-lock-doc-face) + (if (and (eq (get-text-property (point) 'face) 'font-lock-doc-face) (save-excursion (forward-line 0) (skip-chars-forward " \t") From 38427494d5b86d803f941b77134886ba5eec20dd Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 9 Feb 2023 23:27:50 -0800 Subject: [PATCH 2/3] Fix Pcompletion of "tar" when using unrecognized arguments Previously, arguments to tar like "--warning=no-timestamp" would cause Pcompletion to hang (bug#58921). This simplifies the logic flow by moving all the cases for "--" arguments inside the THEN form of '(if (pcomplete-match "^--" 0)', and for all "-" arguments inside the ELSE form. * lisp/pcmpl-gnu.el (pcmpl-gnu--tar-long-options): New variable. (pcomplete/tar): Properly handle completion of arguments that look like "--ARG=", even if they're not recognized by this function. --- lisp/pcmpl-gnu.el | 269 ++++++++++++++++++++++------------------------ 1 file changed, 127 insertions(+), 142 deletions(-) diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index 7d270ea789f..1553c3efed7 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -184,6 +184,86 @@ Return the new list." (when (and (not ,exist) (buffer-live-p ,buf)) (kill-buffer ,buf)))))) +(defvar pcmpl-gnu--tar-long-options + ;; FIXME: Extract this list from "tar --help". + '("--absolute-names" + "--after-date=" + "--append" + "--atime-preserve" + "--backup" + "--block-number" + "--blocking-factor=" + "--catenate" + "--checkpoint" + "--compare" + "--compress" + "--concatenate" + "--confirmation" + "--create" + "--delete" + "--dereference" + "--diff" + "--directory=" + "--exclude=" + "--exclude-from=" + "--extract" + "--file=" + "--files-from=" + "--force-local" + "--get" + "--group=" + "--gzip" + "--help" + "--ignore-failed-read" + "--ignore-zeros" + "--incremental" + "--info-script=" + "--interactive" + "--keep-old-files" + "--label=" + "--list" + "--listed-incremental" + "--mode=" + "--modification-time" + "--multi-volume" + "--new-volume-script=" + "--newer=" + "--newer-mtime" + "--no-recursion" + "--null" + "--numeric-owner" + "--old-archive" + "--one-file-system" + "--owner=" + "--portability" + "--posix" + "--preserve" + "--preserve-order" + "--preserve-permissions" + "--read-full-records" + "--record-size=" + "--recursive-unlink" + "--remove-files" + "--rsh-command=" + "--same-order" + "--same-owner" + "--same-permissions" + "--sparse" + "--starting-file=" + "--suffix=" + "--tape-length=" + "--to-stdout" + "--totals" + "--uncompress" + "--ungzip" + "--unlink-first" + "--update" + "--use-compress-program=" + "--verbose" + "--verify" + "--version" + "--volno-file=")) + ;;;###autoload (defun pcomplete/tar () "Completion for the GNU tar utility." @@ -192,148 +272,53 @@ Return the new list." (while (pcomplete-match "^-" 0) (setq saw-option t) (if (pcomplete-match "^--" 0) - (if (pcomplete-match "^--\\([^= \t\n\f]*\\)\\'" 0) - ;; FIXME: Extract this list from "tar --help". - (pcomplete-here* - '("--absolute-names" - "--after-date=" - "--append" - "--atime-preserve" - "--backup" - "--block-number" - "--blocking-factor=" - "--catenate" - "--checkpoint" - "--compare" - "--compress" - "--concatenate" - "--confirmation" - "--create" - "--delete" - "--dereference" - "--diff" - "--directory=" - "--exclude=" - "--exclude-from=" - "--extract" - "--file=" - "--files-from=" - "--force-local" - "--get" - "--group=" - "--gzip" - "--help" - "--ignore-failed-read" - "--ignore-zeros" - "--incremental" - "--info-script=" - "--interactive" - "--keep-old-files" - "--label=" - "--list" - "--listed-incremental" - "--mode=" - "--modification-time" - "--multi-volume" - "--new-volume-script=" - "--newer=" - "--newer-mtime" - "--no-recursion" - "--null" - "--numeric-owner" - "--old-archive" - "--one-file-system" - "--owner=" - "--portability" - "--posix" - "--preserve" - "--preserve-order" - "--preserve-permissions" - "--read-full-records" - "--record-size=" - "--recursive-unlink" - "--remove-files" - "--rsh-command=" - "--same-order" - "--same-owner" - "--same-permissions" - "--sparse" - "--starting-file=" - "--suffix=" - "--tape-length=" - "--to-stdout" - "--totals" - "--uncompress" - "--ungzip" - "--unlink-first" - "--update" - "--use-compress-program=" - "--verbose" - "--verify" - "--version" - "--volno-file="))) - (pcomplete-opt "01234567ABCFGKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz")) - (cond - ((pcomplete-match "\\`-\\'" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--after-date=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--backup=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--blocking-factor=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--directory=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-dirs) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--exclude-from=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-entries) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--exclude=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--\\(extract\\|list\\)\\'" 0) - (setq complete-within t)) - ((pcomplete-match "\\`--file=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-dirs-or-entries pcmpl-gnu-tarfile-regexp) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--files-from=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-entries) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--group=\\(.*\\)" 0) - (pcomplete-here* (pcmpl-unix-group-names) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--info-script=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-entries) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--label=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--mode=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--new-volume-script=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-entries) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--newer=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--owner=\\(.*\\)" 0) - (pcomplete-here* (pcmpl-unix-user-names) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--record-size=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--rsh-command=\\(.*\\)" 0) - (pcomplete-here* (funcall pcomplete-command-completion-function) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--starting-file=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-entries) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--suffix=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--tape-length=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--use-compress-program=\\(.*\\)" 0) - (pcomplete-here* (funcall pcomplete-command-completion-function) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--volno-file=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-entries) - (pcomplete-match-string 1 0))))) + (cond + ((pcomplete-match "^--\\([^= \t\n\f]*\\)\\'" 0) + (pcomplete-here* pcmpl-gnu--tar-long-options)) + ((pcomplete-match "\\`--directory=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-dirs) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--exclude-from=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-entries) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--\\(extract\\|list\\)\\'" 0) + (setq complete-within t)) + ((pcomplete-match "\\`--file=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-dirs-or-entries + pcmpl-gnu-tarfile-regexp) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--files-from=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-entries) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--group=\\(.*\\)" 0) + (pcomplete-here* (pcmpl-unix-group-names) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--info-script=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-entries) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--new-volume-script=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-entries) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--owner=\\(.*\\)" 0) + (pcomplete-here* (pcmpl-unix-user-names) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--rsh-command=\\(.*\\)" 0) + (pcomplete-here* (funcall pcomplete-command-completion-function) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--starting-file=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-entries) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--use-compress-program=\\(.*\\)" 0) + (pcomplete-here* (funcall pcomplete-command-completion-function) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--volno-file=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-entries) + (pcomplete-match-string 1 0))) + (t + (pcomplete-here*))) + (pcomplete-opt "01234567ABCFGKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz") + (when (pcomplete-match "\\`-\\'" 0) + (pcomplete-here*)))) (unless saw-option (pcomplete-here (mapcar #'char-to-string From da4f1fa550f753e76c611b313d4f00987daed5ad Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 4 Mar 2023 14:53:01 -0700 Subject: [PATCH 3/3] server-eval-at: Signal more specific condition on unreadable result * lisp/server.el (server-return-invalid-read-syntax): New error signal. (server-eval-at): Re-signal invalid-read-syntax as server-return-invalid-read-syntax (bug#61658). --- lisp/server.el | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) diff --git a/lisp/server.el b/lisp/server.el index 35b38ef8fa6..89aedc72d52 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1929,12 +1929,22 @@ This sets the variable `server-stop-automatically' (which see)." ;; continue standard unloading nil) +(define-error 'server-return-invalid-read-syntax + "Emacs server returned unreadable result of evaluation" + 'invalid-read-syntax) + (defun server-eval-at (server form) "Contact the Emacs server named SERVER and evaluate FORM there. -Returns the result of the evaluation, or signals an error if it -cannot contact the specified server. For example: +Returns the result of the evaluation. For example: (server-eval-at \"server\" \\='(emacs-pid)) -returns the process ID of the Emacs instance running \"server\"." +returns the process ID of the Emacs instance running \"server\". + +This function signals `error' if it could not contact the server. + +This function signals `server-return-invalid-read-syntax' if it +couldn't read the result of evaluation printed by the server. +This will occur whenever the result of evaluating FORM is something +not readably printable." (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)) (server-file (expand-file-name server server-dir)) (coding-system-for-read 'binary) @@ -1980,8 +1990,14 @@ returns the process ID of the Emacs instance running \"server\"." (progn (skip-chars-forward "^\n") (point)))))) (if (not (equal answer "")) - (read (decode-coding-string (server-unquote-arg answer) - 'emacs-internal))))))) + (condition-case err + (read + (decode-coding-string (server-unquote-arg answer) + 'emacs-internal)) + ;; Re-signal with a more specific condition. + (invalid-read-syntax + (signal 'server-return-invalid-read-syntax + (cdr err))))))))) (provide 'server)