restore 2008-07-30T14:50:08Z!dann@ics.uci.edu

[gnu-emacs] / lisp / subr.el

diff --git a/lisp/subr.el b/lisp/subr.el
index 8c7d89591d9477aabf197c4841848d8f9d951d88..b15e463693a02b24f7788aff44c8897b463fa103 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -8,10 +8,10 @@
 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 

-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify

 ;; it under the terms of the GNU General Public License as published by
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.

 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of


@@ -19,9 +19,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License

-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -204,6 +202,11 @@ the return value (nil if RESULT is omitted).
 Treated as a declaration when used at the right place in a
 `defmacro' form.  \(See Info anchor `(elisp)Definition of declare'.)"
   nil)
 Treated as a declaration when used at the right place in a
 `defmacro' form.  \(See Info anchor `(elisp)Definition of declare'.)"
   nil)

+
+(defmacro ignore-errors (&rest body)
+  "Execute BODY; if an error occurs, return nil.
+Otherwise, return result of last form in BODY."
+  `(condition-case nil (progn ,@body) (error nil)))

 \f
 ;;;; Basic Lisp functions.
 
 \f
 ;;;; Basic Lisp functions.
 


@@ -231,17 +234,17 @@ configuration."
        (eq (car object) 'frame-configuration)))
 
 (defun functionp (object)
        (eq (car object) 'frame-configuration)))
 
 (defun functionp (object)

-  "Non-nil if OBJECT is any kind of function or a special form.
-Also non-nil if OBJECT is a symbol and its function definition is
-\(recursively) a function or special form.  This does not include
-macros."
+  "Non-nil if OBJECT is a function."

   (or (and (symbolp object) (fboundp object)
           (condition-case nil
               (setq object (indirect-function object))
             (error nil))
           (eq (car-safe object) 'autoload)
           (not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object)))))))
   (or (and (symbolp object) (fboundp object)
           (condition-case nil
               (setq object (indirect-function object))
             (error nil))
           (eq (car-safe object) 'autoload)
           (not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object)))))))

-      (subrp object) (byte-code-function-p object)
+      (and (subrp object)
+           ;; Filter out special forms.
+           (not (eq 'unevalled (cdr (subr-arity object)))))
+      (byte-code-function-p object)

       (eq (car-safe object) 'lambda)))
 \f
 ;;;; List functions.
       (eq (car-safe object) 'lambda)))
 \f
 ;;;; List functions.


@@ -382,14 +385,14 @@ If TEST is omitted or nil, `equal' is used."
       (setq tail (cdr tail)))
     value))
 
       (setq tail (cdr tail)))
     value))
 

-(make-obsolete 'assoc-ignore-case 'assoc-string)
+(make-obsolete 'assoc-ignore-case 'assoc-string "22.1")

 (defun assoc-ignore-case (key alist)
   "Like `assoc', but ignores differences in case and text representation.
 KEY must be a string.  Upper-case and lower-case letters are treated as equal.
 Unibyte strings are converted to multibyte for comparison."
   (assoc-string key alist t))
 
 (defun assoc-ignore-case (key alist)
   "Like `assoc', but ignores differences in case and text representation.
 KEY must be a string.  Upper-case and lower-case letters are treated as equal.
 Unibyte strings are converted to multibyte for comparison."
   (assoc-string key alist t))
 

-(make-obsolete 'assoc-ignore-representation 'assoc-string)
+(make-obsolete 'assoc-ignore-representation 'assoc-string "22.1")

 (defun assoc-ignore-representation (key alist)
   "Like `assoc', but ignores differences in text representation.
 KEY must be a string.
 (defun assoc-ignore-representation (key alist)
   "Like `assoc', but ignores differences in text representation.
 KEY must be a string.


@@ -532,25 +535,50 @@ The order of bindings in a keymap matters when it is used as a menu."
            (setq inserted t)))
       (setq tail (cdr tail)))))
 
            (setq inserted t)))
       (setq tail (cdr tail)))))
 

-(defun map-keymap-internal (function keymap &optional sort-first)
+(defun map-keymap-sorted (function keymap)

   "Implement `map-keymap' with sorting.
 Don't call this function; it is for internal use only."
   "Implement `map-keymap' with sorting.
 Don't call this function; it is for internal use only."

-  (if sort-first
-      (let (list)
-       (map-keymap (lambda (a b) (push (cons a b) list))
-                   keymap)
-       (setq list (sort list
-                        (lambda (a b)
-                          (setq a (car a) b (car b))
-                          (if (integerp a)
-                              (if (integerp b) (< a b)
-                                t)
-                            (if (integerp b) t
-                               ;; string< also accepts symbols.
-                              (string< a b))))))
-       (dolist (p list)
-         (funcall function (car p) (cdr p))))
-    (map-keymap function keymap)))
+  (let (list)
+    (map-keymap (lambda (a b) (push (cons a b) list))
+                keymap)
+    (setq list (sort list
+                     (lambda (a b)
+                       (setq a (car a) b (car b))
+                       (if (integerp a)
+                           (if (integerp b) (< a b)
+                             t)
+                         (if (integerp b) t
+                           ;; string< also accepts symbols.
+                           (string< a b))))))
+    (dolist (p list)
+      (funcall function (car p) (cdr p)))))
+
+(defun keymap-canonicalize (map)
+  "Return an equivalent keymap, without inheritance."
+  (let ((bindings ())
+        (ranges ()))
+    (while (keymapp map)
+      (setq map (map-keymap-internal
+                 (lambda (key item)
+                   (if (consp key)
+                       ;; Treat char-ranges specially.
+                       (push (cons key item) ranges)
+                     (push (cons key item) bindings)))
+                 map)))
+    (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap)
+                       (keymap-prompt map)))
+    (dolist (binding ranges)
+      ;; Treat char-ranges specially.
+      (define-key map (vector (car binding)) (cdr binding)))
+    (dolist (binding (prog1 bindings (setq bindings ())))
+      (let* ((key (car binding))
+             (item (cdr binding))
+             (oldbind (assq key bindings)))
+        ;; Newer bindings override older.
+        (if oldbind (setq bindings (delq oldbind bindings)))
+        (when item                      ;nil bindings just hide older ones.
+          (push binding bindings))))
+    (nconc map bindings)))

 
 (put 'keyboard-translate-table 'char-table-extra-slots 0)
 
 
 (put 'keyboard-translate-table 'char-table-extra-slots 0)
 


@@ -803,6 +831,11 @@ in the current Emacs session, then this function may return nil."
   "Return non-nil if OBJECT is a mouse movement event."
   (eq (car-safe object) 'mouse-movement))
 
   "Return non-nil if OBJECT is a mouse movement event."
   (eq (car-safe object) 'mouse-movement))
 

+(defun mouse-event-p (object)
+  "Return non-nil if OBJECT is a mouse click event."
+  ;; is this really correct? maybe remove mouse-movement?
+  (memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement)))
+

 (defsubst event-start (event)
   "Return the starting position of EVENT.
 If EVENT is a mouse or key press or a mouse click, this returns the location
 (defsubst event-start (event)
   "Return the starting position of EVENT.
 If EVENT is a mouse or key press or a mouse click, this returns the location


@@ -872,6 +905,8 @@ POSITION should be a list of the form returned by the `event-start'
 and `event-end' functions."
   (nth 2 position))
 
 and `event-end' functions."
   (nth 2 position))
 

+(declare-function scroll-bar-scale "scroll-bar" (num-denom whole))
+

 (defun posn-col-row (position)
   "Return the nominal column and row in POSITION, measured in characters.
 The column and row values are approximations calculated from the x
 (defun posn-col-row (position)
   "Return the nominal column and row in POSITION, measured in characters.
 The column and row values are approximations calculated from the x


@@ -988,6 +1023,13 @@ is converted into a string by expressing it in decimal."
 \f
 ;;;; Obsolescence declarations for variables, and aliases.
 
 \f
 ;;;; Obsolescence declarations for variables, and aliases.
 

+(make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1")
+(make-obsolete 'window-redisplay-end-trigger nil "23.1")
+(make-obsolete 'set-window-redisplay-end-trigger nil "23.1")
+
+(make-obsolete 'process-filter-multibyte-p nil "23.1")
+(make-obsolete 'set-process-filter-multibyte nil "23.1")
+

 (make-obsolete-variable 'directory-sep-char "do not use it." "21.1")
 (make-obsolete-variable
  'mode-line-inverse-video
 (make-obsolete-variable 'directory-sep-char "do not use it." "21.1")
 (make-obsolete-variable
  'mode-line-inverse-video


@@ -1009,6 +1051,9 @@ to reread, so it now uses nil to mean `no event', instead of -1."
 (defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
 (make-obsolete-variable 'x-sent-selection-hooks
                        'x-sent-selection-functions "22.1")
 (defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
 (make-obsolete-variable 'x-sent-selection-hooks
                        'x-sent-selection-functions "22.1")

+;; This was introduced in 21.4 for pre-unicode unification and was rendered
+;; obsolete by the use of Unicode internally in 23.1.
+(make-obsolete-variable 'translation-table-for-input nil "23.1")

 
 (defvaralias 'messages-buffer-max-lines 'message-log-max)
 \f
 
 (defvaralias 'messages-buffer-max-lines 'message-log-max)
 \f


@@ -1441,7 +1486,6 @@ definition only or variable definition only.
        (setq files (cdr files)))
       file)))
 
        (setq files (cdr files)))
       file)))
 

-;;;###autoload

 (defun locate-library (library &optional nosuffix path interactive-call)
   "Show the precise file name of Emacs library LIBRARY.
 This command searches the directories in `load-path' like `\\[load-library]'
 (defun locate-library (library &optional nosuffix path interactive-call)
   "Show the precise file name of Emacs library LIBRARY.
 This command searches the directories in `load-path' like `\\[load-library]'


@@ -1452,12 +1496,13 @@ to the specified name LIBRARY.
 If the optional third arg PATH is specified, that list of directories
 is used instead of `load-path'.
 
 If the optional third arg PATH is specified, that list of directories
 is used instead of `load-path'.
 

-When called from a program, the file name is normaly returned as a
+When called from a program, the file name is normally returned as a

 string.  When run interactively, the argument INTERACTIVE-CALL is t,
 and the file name is displayed in the echo area."
   (interactive (list (completing-read "Locate library: "
 string.  When run interactively, the argument INTERACTIVE-CALL is t,
 and the file name is displayed in the echo area."
   (interactive (list (completing-read "Locate library: "

-                                     'locate-file-completion
-                                     (cons load-path (get-load-suffixes)))
+                                     (apply-partially
+                                       'locate-file-completion-table
+                                       load-path (get-load-suffixes)))

                     nil nil
                     t))
   (let ((file (locate-file library
                     nil nil
                     t))
   (let ((file (locate-file library


@@ -1693,7 +1738,10 @@ any other non-digit terminates the character code and is then used as input."))
       ;; We could try and use read-key-sequence instead, but then C-q ESC
       ;; or C-q C-x might not return immediately since ESC or C-x might be
       ;; bound to some prefix in function-key-map or key-translation-map.
       ;; We could try and use read-key-sequence instead, but then C-q ESC
       ;; or C-q C-x might not return immediately since ESC or C-x might be
       ;; bound to some prefix in function-key-map or key-translation-map.

-      (setq translated char)
+      (setq translated
+           (if (integerp char)
+               (char-resolve-modifers char)
+             char))

       (let ((translation (lookup-key local-function-key-map (vector char))))
        (if (arrayp translation)
            (setq translated (aref translation 0))))
       (let ((translation (lookup-key local-function-key-map (vector char))))
        (if (arrayp translation)
            (setq translated (aref translation 0))))


@@ -1831,9 +1879,10 @@ in milliseconds; this was useful when Emacs was built without
 floating point support.
 
 \(fn SECONDS &optional NODISP)"
 floating point support.
 
 \(fn SECONDS &optional NODISP)"

-  (when (or obsolete (numberp nodisp))
-    (setq seconds (+ seconds (* 1e-3 nodisp)))
-    (setq nodisp obsolete))
+  (if (numberp nodisp)
+      (setq seconds (+ seconds (* 1e-3 nodisp))
+            nodisp obsolete)
+    (if obsolete (setq nodisp obsolete)))

   (cond
    (noninteractive
     (sleep-for seconds)
   (cond
    (noninteractive
     (sleep-for seconds)


@@ -1943,24 +1992,25 @@ This finishes the change group by reverting all of its changes."
     (with-current-buffer (car elt)
       (setq elt (cdr elt))
       (let ((old-car
     (with-current-buffer (car elt)
       (setq elt (cdr elt))
       (let ((old-car

-            (if (consp elt) (car elt)))
-           (old-cdr
-            (if (consp elt) (cdr elt))))
-       ;; Temporarily truncate the undo log at ELT.
-       (when (consp elt)
-         (setcar elt nil) (setcdr elt nil))
-       (unless (eq last-command 'undo) (undo-start))
-       ;; Make sure there's no confusion.
-       (when (and (consp elt) (not (eq elt (last pending-undo-list))))
-         (error "Undoing to some unrelated state"))
-       ;; Undo it all.
-       (while (listp pending-undo-list) (undo-more 1))
-       ;; Reset the modified cons cell ELT to its original content.
-       (when (consp elt)
-         (setcar elt old-car)
-         (setcdr elt old-cdr))
-       ;; Revert the undo info to what it was when we grabbed the state.
-       (setq buffer-undo-list elt)))))
+             (if (consp elt) (car elt)))
+            (old-cdr
+             (if (consp elt) (cdr elt))))
+        ;; Temporarily truncate the undo log at ELT.
+        (when (consp elt)
+          (setcar elt nil) (setcdr elt nil))
+        (unless (eq last-command 'undo) (undo-start))
+        ;; Make sure there's no confusion.
+        (when (and (consp elt) (not (eq elt (last pending-undo-list))))
+          (error "Undoing to some unrelated state"))
+        ;; Undo it all.
+        (save-excursion
+          (while (listp pending-undo-list) (undo-more 1)))
+        ;; Reset the modified cons cell ELT to its original content.
+        (when (consp elt)
+          (setcar elt old-car)
+          (setcdr elt old-cdr))
+        ;; Revert the undo info to what it was when we grabbed the state.
+        (setq buffer-undo-list elt)))))

 \f
 ;;;; Display-related functions.
 
 \f
 ;;;; Display-related functions.
 


@@ -1986,56 +2036,37 @@ input (as a command if nothing else).
 Display MESSAGE (optional fourth arg) in the echo area.
 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
   (or exit-char (setq exit-char ?\s))
 Display MESSAGE (optional fourth arg) in the echo area.
 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
   (or exit-char (setq exit-char ?\s))

-  (let ((inhibit-read-only t)
-       ;; Don't modify the undo list at all.
-       (buffer-undo-list t)
-       (modified (buffer-modified-p))
-       (name buffer-file-name)
-       insert-end)
+  (let ((ol (make-overlay pos pos))
+        (message (copy-sequence string)))

     (unwind-protect
     (unwind-protect

-       (progn
-         (save-excursion
-           (goto-char pos)
-           ;; To avoid trouble with out-of-bounds position
-           (setq pos (point))
-           ;; defeat file locking... don't try this at home, kids!
-           (setq buffer-file-name nil)
-           (insert-before-markers string)
-           (setq insert-end (point))
-           ;; If the message end is off screen, recenter now.
-           (if (< (window-end nil t) insert-end)
-               (recenter (/ (window-height) 2)))
-           ;; If that pushed message start off the screen,
-           ;; scroll to start it at the top of the screen.
-           (move-to-window-line 0)
-           (if (> (point) pos)
-               (progn
-                 (goto-char pos)
-                 (recenter 0))))
-         (message (or message "Type %s to continue editing.")
-                  (single-key-description exit-char))
-         (let (char)
-           (if (integerp exit-char)
-               (condition-case nil
-                   (progn
-                     (setq char (read-char))
-                     (or (eq char exit-char)
-                         (setq unread-command-events (list char))))
-                 (error
-                  ;; `exit-char' is a character, hence it differs
-                  ;; from char, which is an event.
-                  (setq unread-command-events (list char))))
-             ;; `exit-char' can be an event, or an event description
-             ;; list.
-             (setq char (read-event))
-             (or (eq char exit-char)
-                 (eq char (event-convert-list exit-char))
-                 (setq unread-command-events (list char))))))
-      (if insert-end
-         (save-excursion
-           (delete-region pos insert-end)))
-      (setq buffer-file-name name)
-      (set-buffer-modified-p modified))))
+        (progn
+          (save-excursion
+            (overlay-put ol 'after-string message)
+            (goto-char pos)
+            ;; To avoid trouble with out-of-bounds position
+            (setq pos (point))
+            ;; If the message end is off screen, recenter now.
+            (if (<= (window-end nil t) pos)
+                (recenter (/ (window-height) 2))))
+          (message (or message "Type %s to continue editing.")
+                   (single-key-description exit-char))
+          (let (char)
+            (if (integerp exit-char)
+                (condition-case nil
+                    (progn
+                      (setq char (read-char))
+                      (or (eq char exit-char)
+                          (setq unread-command-events (list char))))
+                  (error
+                   ;; `exit-char' is a character, hence it differs
+                   ;; from char, which is an event.
+                   (setq unread-command-events (list char))))
+              ;; `exit-char' can be an event, or an event description list.
+              (setq char (read-event))
+              (or (eq char exit-char)
+                  (eq char (event-convert-list exit-char))
+                  (setq unread-command-events (list char))))))
+      (delete-overlay ol))))

 
 \f
 ;;;; Overlay operations
 
 \f
 ;;;; Overlay operations


@@ -2375,14 +2406,10 @@ passing the command to the shell.
 Wildcards and redirection are handled as usual in the shell.
 
 \(fn NAME BUFFER COMMAND &rest COMMAND-ARGS)"
 Wildcards and redirection are handled as usual in the shell.
 
 \(fn NAME BUFFER COMMAND &rest COMMAND-ARGS)"

-  (cond
-   ((eq system-type 'vax-vms)
-    (apply 'start-process name buffer args))

    ;; We used to use `exec' to replace the shell with the command,
    ;; but that failed to handle (...) and semicolon, etc.
    ;; We used to use `exec' to replace the shell with the command,
    ;; but that failed to handle (...) and semicolon, etc.

-   (t
-    (start-process name buffer shell-file-name shell-command-switch
-                  (mapconcat 'identity args " ")))))
+  (start-process name buffer shell-file-name shell-command-switch
+                (mapconcat 'identity args " ")))

 
 (defun start-file-process-shell-command (name buffer &rest args)
   "Start a program in a subprocess.  Return the process object for it.
 
 (defun start-file-process-shell-command (name buffer &rest args)
   "Start a program in a subprocess.  Return the process object for it.


@@ -2414,16 +2441,12 @@ If BUFFER is 0, `call-process-shell-command' returns immediately with value nil.
 Otherwise it waits for COMMAND to terminate and returns a numeric exit
 status or a signal description string.
 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again."
 Otherwise it waits for COMMAND to terminate and returns a numeric exit
 status or a signal description string.
 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again."

-  (cond
-   ((eq system-type 'vax-vms)
-    (apply 'call-process command infile buffer display args))
-   ;; We used to use `exec' to replace the shell with the command,
-   ;; but that failed to handle (...) and semicolon, etc.
-   (t
-    (call-process shell-file-name
-                 infile buffer display
-                 shell-command-switch
-                 (mapconcat 'identity (cons command args) " ")))))
+  ;; We used to use `exec' to replace the shell with the command,
+  ;; but that failed to handle (...) and semicolon, etc.
+  (call-process shell-file-name
+               infile buffer display
+               shell-command-switch
+               (mapconcat 'identity (cons command args) " ")))

 
 (defun process-file-shell-command (command &optional infile buffer display
                                           &rest args)
 
 (defun process-file-shell-command (command &optional infile buffer display
                                           &rest args)


@@ -2514,8 +2537,7 @@ See also `with-temp-buffer'."
               (with-current-buffer ,temp-buffer
                 ,@body)
             (with-current-buffer ,temp-buffer
               (with-current-buffer ,temp-buffer
                 ,@body)
             (with-current-buffer ,temp-buffer

-              (widen)
-              (write-region (point-min) (point-max) ,temp-file nil 0)))
+              (write-region nil nil ,temp-file nil 0)))

         (and (buffer-name ,temp-buffer)
              (kill-buffer ,temp-buffer))))))
 
         (and (buffer-name ,temp-buffer)
              (kill-buffer ,temp-buffer))))))
 


@@ -2548,11 +2570,12 @@ See also `with-temp-file' and `with-output-to-string'."
   (declare (indent 0) (debug t))
   (let ((temp-buffer (make-symbol "temp-buffer")))
     `(let ((,temp-buffer (generate-new-buffer " *temp*")))
   (declare (indent 0) (debug t))
   (let ((temp-buffer (make-symbol "temp-buffer")))
     `(let ((,temp-buffer (generate-new-buffer " *temp*")))

-       (unwind-protect
-          (with-current-buffer ,temp-buffer
-            ,@body)
-        (and (buffer-name ,temp-buffer)
-             (kill-buffer ,temp-buffer))))))
+       ;; FIXME: kill-buffer can change current-buffer in some odd cases.
+       (with-current-buffer ,temp-buffer
+         (unwind-protect
+            (progn ,@body)
+           (and (buffer-name ,temp-buffer)
+                (kill-buffer ,temp-buffer)))))))

 
 (defmacro with-output-to-string (&rest body)
   "Execute BODY, return the text it sent to `standard-output', as a string."
 
 (defmacro with-output-to-string (&rest body)
   "Execute BODY, return the text it sent to `standard-output', as a string."


@@ -2594,7 +2617,7 @@ If BODY finishes, `while-no-input' returns whatever value BODY produced."
        (catch ',catch-sym
         (let ((throw-on-input ',catch-sym))
           (or (input-pending-p)
        (catch ',catch-sym
         (let ((throw-on-input ',catch-sym))
           (or (input-pending-p)

-              ,@body))))))
+              (progn ,@body)))))))

 
 (defmacro condition-case-no-debug (var bodyform &rest handlers)
   "Like `condition-case' except that it does not catch anything when debugging.
 
 (defmacro condition-case-no-debug (var bodyform &rest handlers)
   "Like `condition-case' except that it does not catch anything when debugging.


@@ -2612,7 +2635,7 @@ More specifically if `debug-on-error' is set, then it does not catch any signal.
   "Run BODY and demote any errors to simple messages.
 If `debug-on-error' is non-nil, run BODY without catching its errors.
 This is to be used around code which is not expected to signal an error
   "Run BODY and demote any errors to simple messages.
 If `debug-on-error' is non-nil, run BODY without catching its errors.
 This is to be used around code which is not expected to signal an error

-but which should be robust in the unexpected case that an error is signalled."
+but which should be robust in the unexpected case that an error is signaled."

   (declare (debug t) (indent 0))
   (let ((err (make-symbol "err")))
     `(condition-case-no-debug ,err
   (declare (debug t) (indent 0))
   (let ((err (make-symbol "err")))
     `(condition-case-no-debug ,err


@@ -2651,92 +2674,6 @@ The value returned is the value of the last form in BODY."
         (with-current-buffer ,old-buffer
           (set-case-table ,old-case-table))))))
 \f
         (with-current-buffer ,old-buffer
           (set-case-table ,old-case-table))))))
 \f

-;;;; Constructing completion tables.
-
-(defun complete-with-action (action table string pred)
-  "Perform completion ACTION.
-STRING is the string to complete.
-TABLE is the completion table, which should not be a function.
-PRED is a completion predicate.
-ACTION can be one of nil, t or `lambda'."
-  ;; (assert (not (functionp table)))
-  (funcall
-   (cond
-    ((null action) 'try-completion)
-    ((eq action t) 'all-completions)
-    (t 'test-completion))
-   string table pred))
-
-(defmacro dynamic-completion-table (fun)
-  "Use function FUN as a dynamic completion table.
-FUN is called with one argument, the string for which completion is required,
-and it should return an alist containing all the intended possible
-completions.  This alist may be a full list of possible completions so that FUN
-can ignore the value of its argument.  If completion is performed in the
-minibuffer, FUN will be called in the buffer from which the minibuffer was
-entered.
-
-The result of the `dynamic-completion-table' form is a function
-that can be used as the ALIST argument to `try-completion' and
-`all-completion'.  See Info node `(elisp)Programmed Completion'."
-  (declare (debug (lambda-expr)))
-  (let ((win (make-symbol "window"))
-        (string (make-symbol "string"))
-        (predicate (make-symbol "predicate"))
-        (mode (make-symbol "mode")))
-    `(lambda (,string ,predicate ,mode)
-       (with-current-buffer (let ((,win (minibuffer-selected-window)))
-                              (if (window-live-p ,win) (window-buffer ,win)
-                                (current-buffer)))
-         (complete-with-action ,mode (,fun ,string) ,string ,predicate)))))
-
-(defmacro lazy-completion-table (var fun)
-  ;; We used to have `&rest args' where `args' were evaluated late (at the
-  ;; time of the call to `fun'), which was counter intuitive.  But to get
-  ;; them to be evaluated early, we have to either use lexical-let (which is
-  ;; not available in subr.el) or use `(lambda (,str) ...) which prevents the use
-  ;; of lexical-let in the callers.
-  ;; So we just removed the argument.  Callers can then simply use either of:
-  ;;   (lazy-completion-table var (lambda () (fun x y)))
-  ;; or
-  ;;   (lazy-completion-table var `(lambda () (fun ',x ',y)))
-  ;; or
-  ;;   (lexical-let ((x x)) ((y y))
-  ;;     (lazy-completion-table var (lambda () (fun x y))))
-  ;; depending on the behavior they want.
-  "Initialize variable VAR as a lazy completion table.
-If the completion table VAR is used for the first time (e.g., by passing VAR
-as an argument to `try-completion'), the function FUN is called with no
-arguments.  FUN must return the completion table that will be stored in VAR.
-If completion is requested in the minibuffer, FUN will be called in the buffer
-from which the minibuffer was entered.  The return value of
-`lazy-completion-table' must be used to initialize the value of VAR.
-
-You should give VAR a non-nil `risky-local-variable' property."
-  (declare (debug (symbol lambda-expr)))
-  (let ((str (make-symbol "string")))
-    `(dynamic-completion-table
-      (lambda (,str)
-        (when (functionp ,var)
-          (setq ,var (,fun)))
-        ,var))))
-
-(defmacro complete-in-turn (a b)
-  "Create a completion table that first tries completion in A and then in B.
-A and B should not be costly (or side-effecting) expressions."
-  (declare (debug (def-form def-form)))
-  `(lambda (string predicate mode)
-     (cond
-      ((eq mode t)
-       (or (all-completions string ,a predicate)
-          (all-completions string ,b predicate)))
-      ((eq mode nil)
-       (or (try-completion string ,a predicate)
-          (try-completion string ,b predicate)))
-      (t
-       (or (test-completion string ,a predicate)
-          (test-completion string ,b predicate))))))
-\f

 ;;; Matching and match data.
 
 (defvar save-match-data-internal)
 ;;; Matching and match data.
 
 (defvar save-match-data-internal)


@@ -2950,10 +2887,11 @@ Modifies the match data; use `save-match-data' if necessary."
 This tries to quote the strings to avoid ambiguity such that
   (split-string-and-unquote (combine-and-quote-strings strs)) == strs
 Only some SEPARATORs will work properly."
 This tries to quote the strings to avoid ambiguity such that
   (split-string-and-unquote (combine-and-quote-strings strs)) == strs
 Only some SEPARATORs will work properly."

-  (let ((sep (or separator " ")))
+  (let* ((sep (or separator " "))
+         (re (concat "[\\\"]" "\\|" (regexp-quote sep))))

     (mapconcat
      (lambda (str)
     (mapconcat
      (lambda (str)

-       (if (string-match "[\\\"]" str)
+       (if (string-match re str)

           (concat "\"" (replace-regexp-in-string "[\\\"]" "\\\\\\&" str) "\"")
         str))
      strings sep)))
           (concat "\"" (replace-regexp-in-string "[\\\"]" "\\\\\\&" str) "\"")
         str))
      strings sep)))