3 files changed, 165 insertions, 161 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
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")
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)