Remove compatibility with Emacs 24.3 in octave-mode

[gnu-emacs] / lisp / subr.el

diff --git a/lisp/subr.el b/lisp/subr.el
index b9a847d76e8c5f968350ea5fe2ba41aac9a09ae2..48ff5013ceea3c2b3a8d799088d0b8beaeac9d8d 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1,6 +1,6 @@
-;;; subr.el --- basic lisp subroutines for Emacs  -*- coding: utf-8; lexical-binding:t -*-
+;;; subr.el --- basic lisp subroutines for Emacs  -*- lexical-binding:t -*-

 
 

-;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2015 Free Software
+;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2016 Free Software

 ;; Foundation, Inc.
 
 ;; Maintainer: emacs-devel@gnu.org
 ;; Foundation, Inc.
 
 ;; Maintainer: emacs-devel@gnu.org


@@ -22,20 +22,18 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 

-;;; Commentary:
-
-;;; Code:
-

 ;; Beware: while this file has tag `utf-8', before it's compiled, it gets
 ;; loaded as "raw-text", so non-ASCII chars won't work right during bootstrap.
 
 ;; Beware: while this file has tag `utf-8', before it's compiled, it gets
 ;; loaded as "raw-text", so non-ASCII chars won't work right during bootstrap.
 

-(defmacro declare-function (_fn _file &optional _arglist _fileonly)
+
+;; declare-function's args use &rest, not &optional, for compatibility
+;; with byte-compile-macroexpand-declare-function.
+
+(defmacro declare-function (_fn _file &rest _args)

   "Tell the byte-compiler that function FN is defined, in FILE.
   "Tell the byte-compiler that function FN is defined, in FILE.

-Optional ARGLIST is the argument list used by the function.

 The FILE argument is not used by the byte-compiler, but by the
 `check-declare' package, which checks that FILE contains a
 The FILE argument is not used by the byte-compiler, but by the
 `check-declare' package, which checks that FILE contains a

-definition for FN.  ARGLIST is used by both the byte-compiler
-and `check-declare' to check for consistency.
+definition for FN.

 
 FILE can be either a Lisp file (in which case the \".el\"
 extension is optional), or a C file.  C files are expanded
 
 FILE can be either a Lisp file (in which case the \".el\"
 extension is optional), or a C file.  C files are expanded


@@ -46,19 +44,22 @@ declaration.  A FILE with an \"ext:\" prefix is an external file.
 `check-declare' will check such files if they are found, and skip
 them without error if they are not.
 
 `check-declare' will check such files if they are found, and skip
 them without error if they are not.
 

-FILEONLY non-nil means that `check-declare' will only check that
-FILE exists, not that it defines FN.  This is intended for
-function-definitions that `check-declare' does not recognize, e.g.
-`defstruct'.
+Optional ARGLIST specifies FN's arguments, or is t to not specify
+FN's arguments.  An omitted ARGLIST defaults to t, not nil: a nil
+ARGLIST specifies an empty argument list, and an explicit t
+ARGLIST is a placeholder that allows supplying a later arg.

 
 

-To specify a value for FILEONLY without passing an argument list,
-set ARGLIST to t.  This is necessary because nil means an
-empty argument list, rather than an unspecified one.
+Optional FILEONLY non-nil means that `check-declare' will check
+only that FILE exists, not that it defines FN.  This is intended
+for function definitions that `check-declare' does not recognize,
+e.g., `defstruct'.

 
 Note that for the purposes of `check-declare', this statement
 must be the first non-whitespace on a line.
 
 For more information, see Info node `(elisp)Declaring Functions'."
 
 Note that for the purposes of `check-declare', this statement
 must be the first non-whitespace on a line.
 
 For more information, see Info node `(elisp)Declaring Functions'."

+  (declare (advertised-calling-convention
+           (fn file &optional arglist fileonly) nil))

   ;; Does nothing - byte-compile-declare-function does the work.
   nil)
 
   ;; Does nothing - byte-compile-declare-function does the work.
   nil)
 


@@ -66,6 +67,7 @@ For more information, see Info node `(elisp)Declaring Functions'."
 ;;;; Basic Lisp macros.
 
 (defalias 'not 'null)
 ;;;; Basic Lisp macros.
 
 (defalias 'not 'null)

+(defalias 'sxhash 'sxhash-equal)

 
 (defmacro noreturn (form)
   "Evaluate FORM, expecting it not to return.
 
 (defmacro noreturn (form)
   "Evaluate FORM, expecting it not to return.


@@ -290,22 +292,28 @@ This function accepts any number of arguments, but ignores them."
 
 ;; Signal a compile-error if the first arg is missing.
 (defun error (&rest args)
 
 ;; Signal a compile-error if the first arg is missing.
 (defun error (&rest args)

-  "Signal an error, making error message by passing all args to `format'.
+  "Signal an error, making a message by passing args to `format-message'.

 In Emacs, the convention is that error messages start with a capital
 letter but *do not* end with a period.  Please follow this convention
 In Emacs, the convention is that error messages start with a capital
 letter but *do not* end with a period.  Please follow this convention

-for the sake of consistency."
+for the sake of consistency.
+
+Note: (error \"%s\" VALUE) makes the message VALUE without
+interpreting format characters like `%', `\\=`', and `\\=''."

   (declare (advertised-calling-convention (string &rest args) "23.1"))
   (declare (advertised-calling-convention (string &rest args) "23.1"))

-  (signal 'error (list (apply 'format args))))
+  (signal 'error (list (apply #'format-message args))))

 
 (defun user-error (format &rest args)
 
 (defun user-error (format &rest args)

-  "Signal a pilot error, making error message by passing all args to `format'.
+  "Signal a pilot error, making a message by passing args to `format-message'.

 In Emacs, the convention is that error messages start with a capital
 letter but *do not* end with a period.  Please follow this convention
 for the sake of consistency.
 This is just like `error' except that `user-error's are expected to be the
 result of an incorrect manipulation on the part of the user, rather than the
 In Emacs, the convention is that error messages start with a capital
 letter but *do not* end with a period.  Please follow this convention
 for the sake of consistency.
 This is just like `error' except that `user-error's are expected to be the
 result of an incorrect manipulation on the part of the user, rather than the

-result of an actual problem."
-  (signal 'user-error (list (apply #'format format args))))
+result of an actual problem.
+
+Note: (user-error \"%s\" VALUE) makes the message VALUE without
+interpreting format characters like `%', `\\=`', and `\\=''."
+  (signal 'user-error (list (apply #'format-message format args))))

 
 (defun define-error (name message &optional parent)
   "Define NAME as a new error signal.
 
 (defun define-error (name message &optional parent)
   "Define NAME as a new error signal.


@@ -426,8 +434,8 @@ one is kept."
             (let ((elt (car retail)))
               (if (gethash elt hash)
                   (setcdr tail (cdr retail))
             (let ((elt (car retail)))
               (if (gethash elt hash)
                   (setcdr tail (cdr retail))

-                (puthash elt t hash)))
-            (setq tail retail)))
+                (puthash elt t hash)
+                (setq tail retail)))))

       (let ((tail list))
         (while tail
           (setcdr tail (delete (car tail) (cdr tail)))
       (let ((tail list))
         (while tail
           (setcdr tail (delete (car tail) (cdr tail)))


@@ -440,16 +448,16 @@ one is kept."
 First and last elements are considered consecutive if CIRCULAR is
 non-nil."
   (let ((tail list) last)
 First and last elements are considered consecutive if CIRCULAR is
 non-nil."
   (let ((tail list) last)

-    (while (consp tail)
+    (while (cdr tail)

       (if (equal (car tail) (cadr tail))
          (setcdr tail (cddr tail))
       (if (equal (car tail) (cadr tail))
          (setcdr tail (cddr tail))

-       (setq last (car tail)
+       (setq last tail

              tail (cdr tail))))
     (if (and circular
              tail (cdr tail))))
     (if (and circular

-            (cdr list)
-            (equal last (car list)))
-       (nbutlast list)
-      list)))
+            last
+            (equal (car tail) (car list)))
+       (setcdr last nil)))
+  list)

 
 (defun number-sequence (from &optional to inc)
   "Return a sequence of numbers from FROM to TO (both inclusive) as a list.
 
 (defun number-sequence (from &optional to inc)
   "Return a sequence of numbers from FROM to TO (both inclusive) as a list.


@@ -478,13 +486,16 @@ of course, also replace TO with a slightly larger value
       (list from)
     (or inc (setq inc 1))
     (when (zerop inc) (error "The increment can not be zero"))
       (list from)
     (or inc (setq inc 1))
     (when (zerop inc) (error "The increment can not be zero"))

-    (let (seq (n 0) (next from))
+    (let (seq (n 0) (next from) (last from))

       (if (> inc 0)
       (if (> inc 0)

-          (while (<= next to)
+          ;; The (>= next last) condition protects against integer
+          ;; overflow in computing NEXT.
+          (while (and (>= next last) (<= next to))

             (setq seq (cons next seq)
                   n (1+ n)
             (setq seq (cons next seq)
                   n (1+ n)

+                  last next

                   next (+ from (* n inc))))
                   next (+ from (* n inc))))

-        (while (>= next to)
+        (while (and (<= next last) (>= next to))

           (setq seq (cons next seq)
                 n (1+ n)
                 next (+ from (* n inc)))))
           (setq seq (cons next seq)
                 n (1+ n)
                 next (+ from (* n inc)))))


@@ -589,10 +600,12 @@ Elements of ALIST that are not conses are ignored."
   alist)
 
 (defun alist-get (key alist &optional default remove)
   alist)
 
 (defun alist-get (key alist &optional default remove)

-  "Get the value associated to KEY in ALIST.
-DEFAULT is the value to return if KEY is not found in ALIST.
-REMOVE, if non-nil, means that when setting this element, we should
-remove the entry if the new value is `eql' to DEFAULT."
+  "Return the value associated with KEY in ALIST, using `assq'.
+If KEY is not found in ALIST, return DEFAULT.
+
+This is a generalized variable suitable for use with `setf'.
+When using it to set a value, optional argument REMOVE non-nil
+means to remove KEY from ALIST if the new value is `eql' to DEFAULT."

   (ignore remove) ;;Silence byte-compiler.
   (let ((x (assq key alist)))
     (if x (cdr x) default)))
   (ignore remove) ;;Silence byte-compiler.
   (let ((x (assq key alist)))
     (if x (cdr x) default)))


@@ -619,8 +632,10 @@ side-effects, and the argument LIST is not modified."
 
 (defun kbd (keys)
   "Convert KEYS to the internal Emacs key representation.
 
 (defun kbd (keys)
   "Convert KEYS to the internal Emacs key representation.

-KEYS should be a string constant in the format used for
-saving keyboard macros (see `edmacro-mode')."
+KEYS should be a string in the format returned by commands such
+as `C-h k' (`describe-key').
+This is the same format used for saving keyboard macros (see
+`edmacro-mode')."

   ;; Don't use a defalias, since the `pure' property is only true for
   ;; the calling convention of `kbd'.
   (read-kbd-macro keys))
   ;; Don't use a defalias, since the `pure' property is only true for
   ;; the calling convention of `kbd'.
   (read-kbd-macro keys))


@@ -846,7 +861,12 @@ above 127 (such as ISO Latin-1) can be included if you use a vector.
 Note that if KEY has a local binding in the current buffer,
 that local binding will continue to shadow any global binding
 that you make with this function."
 Note that if KEY has a local binding in the current buffer,
 that local binding will continue to shadow any global binding
 that you make with this function."

-  (interactive "KSet key globally: \nCSet key %s to command: ")
+  (interactive
+   (let* ((menu-prompting nil)
+          (key (read-key-sequence "Set key globally: ")))
+     (list key
+           (read-command (format "Set key %s to command: "
+                                 (key-description key))))))

   (or (vectorp key) (stringp key)
       (signal 'wrong-type-argument (list 'arrayp key)))
   (define-key (current-global-map) key command))
   (or (vectorp key) (stringp key)
       (signal 'wrong-type-argument (list 'arrayp key)))
   (define-key (current-global-map) key command))


@@ -1115,6 +1135,7 @@ The return value is a positive integer."
 
 (defun posnp (obj)
   "Return non-nil if OBJ appears to be a valid `posn' object specifying a window.
 
 (defun posnp (obj)
   "Return non-nil if OBJ appears to be a valid `posn' object specifying a window.

+A `posn' object is returned from functions such as `event-start'.

 If OBJ is a valid `posn' object, but specifies a frame rather
 than a window, return nil."
   ;; FIXME: Correct the behavior of this function so that all valid
 If OBJ is a valid `posn' object, but specifies a frame rather
 than a window, return nil."
   ;; FIXME: Correct the behavior of this function so that all valid


@@ -1213,14 +1234,14 @@ and `event-end' functions."
   "Return the window row number in POSITION and character number in that row.
 
 Return nil if POSITION does not contain the actual position; in that case
   "Return the window row number in POSITION and character number in that row.
 
 Return nil if POSITION does not contain the actual position; in that case

-\`posn-col-row' can be used to get approximate values.
+`posn-col-row' can be used to get approximate values.

 POSITION should be a list of the form returned by the `event-start'
 and `event-end' functions.
 
 This function does not account for the width on display, like the
 number of visual columns taken by a TAB or image.  If you need
 the coordinates of POSITION in character units, you should use
 POSITION should be a list of the form returned by the `event-start'
 and `event-end' functions.
 
 This function does not account for the width on display, like the
 number of visual columns taken by a TAB or image.  If you need
 the coordinates of POSITION in character units, you should use

-\`posn-col-row', not this function."
+`posn-col-row', not this function."

   (nth 6 position))
 
 (defsubst posn-timestamp (position)
   (nth 6 position))
 
 (defsubst posn-timestamp (position)


@@ -1320,7 +1341,9 @@ is converted into a string by expressing it in decimal."
 ;; buffer-local.
 
 ;; Not used at all in Emacs, last time I checked:
 ;; buffer-local.
 
 ;; Not used at all in Emacs, last time I checked:

-(make-obsolete-variable 'default-mode-line-format 'mode-line-format "23.2")
+(make-obsolete-variable 'default-mode-line-format
+                        "use (setq-default mode-line-format) or (default-value mode-line-format) instead"
+                        "23.2")

 (make-obsolete-variable 'default-header-line-format 'header-line-format "23.2")
 (make-obsolete-variable 'default-line-spacing 'line-spacing "23.2")
 (make-obsolete-variable 'default-abbrev-mode 'abbrev-mode "23.2")
 (make-obsolete-variable 'default-header-line-format 'header-line-format "23.2")
 (make-obsolete-variable 'default-line-spacing 'line-spacing "23.2")
 (make-obsolete-variable 'default-abbrev-mode 'abbrev-mode "23.2")


@@ -1384,6 +1407,7 @@ is converted into a string by expressing it in decimal."
 (defalias 'send-region 'process-send-region)
 (defalias 'string= 'string-equal)
 (defalias 'string< 'string-lessp)
 (defalias 'send-region 'process-send-region)
 (defalias 'string= 'string-equal)
 (defalias 'string< 'string-lessp)

+(defalias 'string> 'string-greaterp)

 (defalias 'move-marker 'set-marker)
 (defalias 'rplaca 'setcar)
 (defalias 'rplacd 'setcdr)
 (defalias 'move-marker 'set-marker)
 (defalias 'rplaca 'setcar)
 (defalias 'rplacd 'setcdr)


@@ -1502,19 +1526,6 @@ All symbols are bound before the VALUEFORMs are evalled."
      ,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
      ,@body))
 
      ,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
      ,@body))
 

-(defmacro let-when-compile (bindings &rest body)
-  "Like `let', but allow for compile time optimization.
-Use BINDINGS as in regular `let', but in BODY each usage should
-be wrapped in `eval-when-compile'.
-This will generate compile-time constants from BINDINGS."
-  (declare (indent 1) (debug let))
-  (cl-progv (mapcar #'car bindings)
-      (mapcar (lambda (x) (eval (cadr x))) bindings)
-    (macroexpand-all
-     (macroexp-progn
-      body)
-     macroexpand-all-environment)))
-

 (defmacro with-wrapper-hook (hook args &rest body)
   "Run BODY, using wrapper functions from HOOK with additional ARGS.
 HOOK is an abnormal hook.  Each hook function in HOOK \"wraps\"
 (defmacro with-wrapper-hook (hook args &rest body)
   "Run BODY, using wrapper functions from HOOK with additional ARGS.
 HOOK is an abnormal hook.  Each hook function in HOOK \"wraps\"


@@ -1541,6 +1552,10 @@ FUN is then called once."
   (declare (indent 2) (debug (form sexp body))
            (obsolete "use a <foo>-function variable modified by `add-function'."
                      "24.4"))
   (declare (indent 2) (debug (form sexp body))
            (obsolete "use a <foo>-function variable modified by `add-function'."
                      "24.4"))

+  `(subr--with-wrapper-hook-no-warnings ,hook ,args ,@body))
+
+(defmacro subr--with-wrapper-hook-no-warnings (hook args &rest body)
+  "Like (with-wrapper-hook HOOK ARGS BODY), but without warnings."

   ;; We need those two gensyms because CL's lexical scoping is not available
   ;; for function arguments :-(
   (let ((funs (make-symbol "funs"))
   ;; We need those two gensyms because CL's lexical scoping is not available
   ;; for function arguments :-(
   (let ((funs (make-symbol "funs"))


@@ -1605,8 +1620,9 @@ can do the job."
           exp
         (let* ((sym (cadr list-var))
                (append (eval append))
           exp
         (let* ((sym (cadr list-var))
                (append (eval append))

-               (msg (format "`add-to-list' can't use lexical var `%s'; use `push' or `cl-pushnew'"
-                            sym))
+               (msg (format-message
+                     "`add-to-list' can't use lexical var `%s'; use `push' or `cl-pushnew'"
+                     sym))

                ;; Big ugly hack so we only output a warning during
                ;; byte-compilation, and so we can use
                ;; byte-compile-not-lexical-var-p to silence the warning
                ;; Big ugly hack so we only output a warning during
                ;; byte-compilation, and so we can use
                ;; byte-compile-not-lexical-var-p to silence the warning


@@ -1730,6 +1746,11 @@ if it is empty or a duplicate."
 (make-variable-buffer-local 'delayed-mode-hooks)
 (put 'delay-mode-hooks 'permanent-local t)
 
 (make-variable-buffer-local 'delayed-mode-hooks)
 (put 'delay-mode-hooks 'permanent-local t)
 

+(defvar delayed-after-hook-forms nil
+  "List of delayed :after-hook forms waiting to be run.
+These forms come from `define-derived-mode'.")
+(make-variable-buffer-local 'delayed-after-hook-forms)
+

 (defvar change-major-mode-after-body-hook nil
   "Normal hook run in major mode functions, before the mode hooks.")
 
 (defvar change-major-mode-after-body-hook nil
   "Normal hook run in major mode functions, before the mode hooks.")
 


@@ -1738,12 +1759,19 @@ if it is empty or a duplicate."
 
 (defun run-mode-hooks (&rest hooks)
   "Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS.
 
 (defun run-mode-hooks (&rest hooks)
   "Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS.

-If the variable `delay-mode-hooks' is non-nil, does not run any hooks,
+Call `hack-local-variables' to set up file local and directory local
+variables.
+
+If the variable `delay-mode-hooks' is non-nil, does not do anything,

 just adds the HOOKS to the list `delayed-mode-hooks'.
 Otherwise, runs hooks in the sequence: `change-major-mode-after-body-hook',
 just adds the HOOKS to the list `delayed-mode-hooks'.
 Otherwise, runs hooks in the sequence: `change-major-mode-after-body-hook',

-`delayed-mode-hooks' (in reverse order), HOOKS, and finally
-`after-change-major-mode-hook'.  Major mode functions should use
-this instead of `run-hooks' when running their FOO-mode-hook."
+`delayed-mode-hooks' (in reverse order), HOOKS, then runs
+`hack-local-variables', runs the hook `after-change-major-mode-hook', and
+finally evaluates the forms in `delayed-after-hook-forms' (see
+`define-derived-mode').
+
+Major mode functions should use this instead of `run-hooks' when
+running their FOO-mode-hook."

   (if delay-mode-hooks
       ;; Delaying case.
       (dolist (hook hooks)
   (if delay-mode-hooks
       ;; Delaying case.
       (dolist (hook hooks)


@@ -1752,7 +1780,13 @@ this instead of `run-hooks' when running their FOO-mode-hook."
     (setq hooks (nconc (nreverse delayed-mode-hooks) hooks))
     (setq delayed-mode-hooks nil)
     (apply 'run-hooks (cons 'change-major-mode-after-body-hook hooks))
     (setq hooks (nconc (nreverse delayed-mode-hooks) hooks))
     (setq delayed-mode-hooks nil)
     (apply 'run-hooks (cons 'change-major-mode-after-body-hook hooks))

-    (run-hooks 'after-change-major-mode-hook)))
+    (if (buffer-file-name)
+        (with-demoted-errors "File local-variables error: %s"
+          (hack-local-variables 'no-mode)))
+    (run-hooks 'after-change-major-mode-hook)
+    (dolist (form (nreverse delayed-after-hook-forms))
+      (eval form))
+    (setq delayed-after-hook-forms nil)))

 
 (defmacro delay-mode-hooks (&rest body)
   "Execute BODY, but delay any `run-mode-hooks'.
 
 (defmacro delay-mode-hooks (&rest body)
   "Execute BODY, but delay any `run-mode-hooks'.


@@ -2097,6 +2131,10 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
                 (aref keys 1)
               key)))
       (cancel-timer timer)
                 (aref keys 1)
               key)))
       (cancel-timer timer)

+      ;; For some reason, `read-key(-sequence)' leaves the prompt in the echo
+      ;; area, whereas `read-event' seems to empty it just before returning
+      ;; (bug#22714).  So, let's mimic the behavior of `read-event'.
+      (message nil)

       (use-global-map old-global-map))))
 
 (defvar read-passwd-map
       (use-global-map old-global-map))))
 
 (defvar read-passwd-map


@@ -2244,6 +2282,171 @@ keyboard-quit events while waiting for a valid input."
     (message "%s%s" prompt (char-to-string char))
     char))
 
     (message "%s%s" prompt (char-to-string char))
     char))
 

+(defun read-multiple-choice (prompt choices)
+  "Ask user a multiple choice question.
+PROMPT should be a string that will be displayed as the prompt.
+
+CHOICES is an alist where the first element in each entry is a
+character to be entered, the second element is a short name for
+the entry to be displayed while prompting (if there's room, it
+might be shortened), and the third, optional entry is a longer
+explanation that will be displayed in a help buffer if the user
+requests more help.
+
+This function translates user input into responses by consulting
+the bindings in `query-replace-map'; see the documentation of
+that variable for more information.  In this case, the useful
+bindings are `recenter', `scroll-up', and `scroll-down'.  If the
+user enters `recenter', `scroll-up', or `scroll-down' responses,
+perform the requested window recentering or scrolling and ask
+again.
+
+The return value is the matching entry from the CHOICES list.
+
+Usage example:
+
+\(read-multiple-choice \"Continue connecting?\"
+                      '((?a \"always\")
+                        (?s \"session only\")
+                        (?n \"no\")))"
+  (let* ((altered-names nil)
+         (full-prompt
+          (format
+           "%s (%s): "
+           prompt
+           (mapconcat
+            (lambda (elem)
+              (let* ((name (cadr elem))
+                     (pos (seq-position name (car elem)))
+                     (altered-name
+                      (cond
+                       ;; Not in the name string.
+                       ((not pos)
+                        (format "[%c] %s" (car elem) name))
+                       ;; The prompt character is in the name, so highlight
+                       ;; it on graphical terminals...
+                       ((display-supports-face-attributes-p
+                         '(:underline t) (window-frame))
+                        (setq name (copy-sequence name))
+                        (put-text-property pos (1+ pos)
+                                           'face 'read-multiple-choice-face
+                                           name)
+                        name)
+                       ;; And put it in [bracket] on non-graphical terminals.
+                       (t
+                        (concat
+                         (substring name 0 pos)
+                         "["
+                         (upcase (substring name pos (1+ pos)))
+                         "]"
+                         (substring name (1+ pos)))))))
+                (push (cons (car elem) altered-name)
+                      altered-names)
+                altered-name))
+            (append choices '((?? "?")))
+            ", ")))
+         tchar buf wrong-char answer)
+    (save-window-excursion
+      (save-excursion
+       (while (not tchar)
+         (message "%s%s"
+                   (if wrong-char
+                       "Invalid choice.  "
+                     "")
+                   full-prompt)
+          (setq tchar
+                (if (and (display-popup-menus-p)
+                         last-input-event ; not during startup
+                         (listp last-nonmenu-event)
+                         use-dialog-box)
+                    (x-popup-dialog
+                     t
+                     (cons prompt
+                           (mapcar
+                            (lambda (elem)
+                              (cons (capitalize (cadr elem))
+                                    (car elem)))
+                            choices)))
+                  (condition-case nil
+                      (let ((cursor-in-echo-area t))
+                        (read-char))
+                    (error nil))))
+          (setq answer (lookup-key query-replace-map (vector tchar) t))
+          (setq tchar
+                (cond
+                 ((eq answer 'recenter)
+                  (recenter) t)
+                 ((eq answer 'scroll-up)
+                  (ignore-errors (scroll-up-command)) t)
+                 ((eq answer 'scroll-down)
+                  (ignore-errors (scroll-down-command)) t)
+                 ((eq answer 'scroll-other-window)
+                  (ignore-errors (scroll-other-window)) t)
+                 ((eq answer 'scroll-other-window-down)
+                  (ignore-errors (scroll-other-window-down)) t)
+                 (t tchar)))
+          (when (eq tchar t)
+            (setq wrong-char nil
+                  tchar nil))
+          ;; The user has entered an invalid choice, so display the
+          ;; help messages.
+          (when (and (not (eq tchar nil))
+                     (not (assq tchar choices)))
+           (setq wrong-char (not (memq tchar '(?? ?\C-h)))
+                  tchar nil)
+            (when wrong-char
+              (ding))
+            (with-help-window (setq buf (get-buffer-create
+                                         "*Multiple Choice Help*"))
+              (with-current-buffer buf
+                (erase-buffer)
+                (pop-to-buffer buf)
+                (insert prompt "\n\n")
+                (let* ((columns (/ (window-width) 25))
+                       (fill-column 21)
+                       (times 0)
+                       (start (point)))
+                  (dolist (elem choices)
+                    (goto-char start)
+                    (unless (zerop times)
+                      (if (zerop (mod times columns))
+                          ;; Go to the next "line".
+                          (goto-char (setq start (point-max)))
+                        ;; Add padding.
+                        (while (not (eobp))
+                          (end-of-line)
+                          (insert (make-string (max (- (* (mod times columns)
+                                                          (+ fill-column 4))
+                                                       (current-column))
+                                                    0)
+                                               ?\s))
+                          (forward-line 1))))
+                    (setq times (1+ times))
+                    (let ((text
+                           (with-temp-buffer
+                             (insert (format
+                                      "%c: %s\n"
+                                      (car elem)
+                                      (cdr (assq (car elem) altered-names))))
+                             (fill-region (point-min) (point-max))
+                             (when (nth 2 elem)
+                               (let ((start (point)))
+                                 (insert (nth 2 elem))
+                                 (unless (bolp)
+                                   (insert "\n"))
+                                 (fill-region start (point-max))))
+                             (buffer-string))))
+                      (goto-char start)
+                      (dolist (line (split-string text "\n"))
+                        (end-of-line)
+                        (if (bolp)
+                            (insert line "\n")
+                          (insert line))
+                        (forward-line 1)))))))))))
+    (when (buffer-live-p buf)
+      (kill-buffer buf))
+    (assq tchar choices)))
+

 (defun sit-for (seconds &optional nodisp obsolete)
   "Redisplay, then wait for SECONDS seconds.  Stop when input is available.
 SECONDS may be a floating-point value.
 (defun sit-for (seconds &optional nodisp obsolete)
   "Redisplay, then wait for SECONDS seconds.  Stop when input is available.
 SECONDS may be a floating-point value.


@@ -2275,7 +2478,18 @@ floating point support."
     t)
    ((input-pending-p t)
     nil)
     t)
    ((input-pending-p t)
     nil)

-   ((<= seconds 0)
+   ((or (<= seconds 0)
+        ;; We are going to call read-event below, which will record
+        ;; the the next key as part of the macro, even if that key
+        ;; invokes kmacro-end-macro, so if we are recording a macro,
+        ;; the macro will recursively call itself.  In addition, when
+        ;; that key is removed from unread-command-events, it will be
+        ;; recorded the second time, so the macro will have each key
+        ;; doubled.  This used to happen if a macro was defined with
+        ;; Flyspell mode active (because Flyspell calls sit-for in its
+        ;; post-command-hook, see bug #21329.)  To avoid all that, we
+        ;; simply disable the wait when we are recording a macro.
+        defining-kbd-macro)

     (or nodisp (redisplay)))
    (t
     (or nodisp (redisplay))
     (or nodisp (redisplay)))
    (t
     (or nodisp (redisplay))


@@ -2306,7 +2520,8 @@ floating point support."
 (declare-function x-popup-dialog "menu.c" (position contents &optional header))
 
 (defun y-or-n-p (prompt)
 (declare-function x-popup-dialog "menu.c" (position contents &optional header))
 
 (defun y-or-n-p (prompt)

-  "Ask user a \"y or n\" question.  Return t if answer is \"y\".
+  "Ask user a \"y or n\" question.
+Return t if answer is \"y\" and nil if it is \"n\".

 PROMPT is the string to display to ask the question.  It should
 end in a space; `y-or-n-p' adds \"(y or n) \" to it.
 
 PROMPT is the string to display to ask the question.  It should
 end in a space; `y-or-n-p' adds \"(y or n) \" to it.
 


@@ -2347,6 +2562,7 @@ is nil and `use-dialog-box' is non-nil."
                  (t (setq temp-prompt (concat "Please answer y or n.  "
                                               prompt))))))))
      ((and (display-popup-menus-p)
                  (t (setq temp-prompt (concat "Please answer y or n.  "
                                               prompt))))))))
      ((and (display-popup-menus-p)

+           last-input-event             ; not during startup

           (listp last-nonmenu-event)
           use-dialog-box)
       (setq prompt (funcall padded prompt t)
           (listp last-nonmenu-event)
           use-dialog-box)
       (setq prompt (funcall padded prompt t)


@@ -2537,7 +2753,8 @@ If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
            (or (eq event exit-char)
                (eq event (event-convert-list exit-char))
                (setq unread-command-events
            (or (eq event exit-char)
                (eq event (event-convert-list exit-char))
                (setq unread-command-events

-                      (append (this-single-command-raw-keys))))))
+                      (append (this-single-command-raw-keys)
+                              unread-command-events)))))

       (delete-overlay ol))))
 
 \f
       (delete-overlay ol))))
 
 \f


@@ -2624,29 +2841,7 @@ See also `locate-user-emacs-file'.")
   "Determine the boundaries of the default tag, based on text at point.
 Return a cons cell with the beginning and end of the found tag.
 If there is no plausible default, return nil."
   "Determine the boundaries of the default tag, based on text at point.
 Return a cons cell with the beginning and end of the found tag.
 If there is no plausible default, return nil."

-  (let (from to bound)
-    (when (or (progn
-               ;; Look at text around `point'.
-               (save-excursion
-                 (skip-syntax-backward "w_") (setq from (point)))
-               (save-excursion
-                 (skip-syntax-forward "w_") (setq to (point)))
-               (> to from))
-             ;; Look between `line-beginning-position' and `point'.
-             (save-excursion
-               (and (setq bound (line-beginning-position))
-                    (skip-syntax-backward "^w_" bound)
-                    (> (setq to (point)) bound)
-                    (skip-syntax-backward "w_")
-                    (setq from (point))))
-             ;; Look between `point' and `line-end-position'.
-             (save-excursion
-               (and (setq bound (line-end-position))
-                    (skip-syntax-forward "^w_" bound)
-                    (< (setq from (point)) bound)
-                    (skip-syntax-forward "w_")
-                    (setq to (point)))))
-      (cons from to))))
+  (bounds-of-thing-at-point 'symbol))

 
 (defun find-tag-default ()
   "Determine default tag to search for, based on text at point.
 
 (defun find-tag-default ()
   "Determine default tag to search for, based on text at point.


@@ -2709,7 +2904,11 @@ Note: :data and :device are currently not supported on Windows."
 (declare-function w32-shell-dos-semantics "w32-fns" nil)
 
 (defun shell-quote-argument (argument)
 (declare-function w32-shell-dos-semantics "w32-fns" nil)
 
 (defun shell-quote-argument (argument)

-  "Quote ARGUMENT for passing as argument to an inferior shell."
+  "Quote ARGUMENT for passing as argument to an inferior shell.
+
+This function is designed to work with the syntax of your system's
+standard shell, and might produce incorrect results with unusual shells.
+See Info node `(elisp)Security Considerations'."

   (cond
    ((eq system-type 'ms-dos)
     ;; Quote using double quotes, but escape any existing quotes in
   (cond
    ((eq system-type 'ms-dos)
     ;; Quote using double quotes, but escape any existing quotes in


@@ -3298,6 +3497,8 @@ See also `with-temp-file' and `with-output-to-string'."
 
 (defmacro with-silent-modifications (&rest body)
   "Execute BODY, pretending it does not modify the buffer.
 
 (defmacro with-silent-modifications (&rest body)
   "Execute BODY, pretending it does not modify the buffer.

+This macro is Typically used around modifications of
+text-properties which do not really affect the buffer's content.

 If BODY performs real modifications to the buffer's text, other
 than cosmetic ones, undo data may become corrupted.
 
 If BODY performs real modifications to the buffer's text, other
 than cosmetic ones, undo data may become corrupted.
 


@@ -3305,10 +3506,7 @@ This macro will run BODY normally, but doesn't count its buffer
 modifications as being buffer modifications.  This affects things
 like `buffer-modified-p', checking whether the file is locked by
 someone else, running buffer modification hooks, and other things
 modifications as being buffer modifications.  This affects things
 like `buffer-modified-p', checking whether the file is locked by
 someone else, running buffer modification hooks, and other things

-of that nature.
-
-Typically used around modifications of text-properties which do
-not really affect the buffer's content."
+of that nature."

   (declare (debug t) (indent 0))
   (let ((modified (make-symbol "modified")))
     `(let* ((,modified (buffer-modified-p))
   (declare (debug t) (indent 0))
   (let ((modified (make-symbol "modified")))
     `(let* ((,modified (buffer-modified-p))


@@ -3758,9 +3956,9 @@ the match data are the result of matching REGEXP against a substring
 of STRING, the same substring that is the actual text of the match which
 is passed to REP as its argument.
 
 of STRING, the same substring that is the actual text of the match which
 is passed to REP as its argument.
 

-To replace only the first match (if any), make REGEXP match up to \\'
+To replace only the first match (if any), make REGEXP match up to \\\\='

 and replace a sub-expression, e.g.
 and replace a sub-expression, e.g.

-  (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1)
+  (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\\\='\" \"bar\" \" foo foo\" nil nil 1)

     => \" bar foo\""
 
   ;; To avoid excessive consing from multiple matches in long strings,
     => \" bar foo\""
 
   ;; To avoid excessive consing from multiple matches in long strings,


@@ -3834,6 +4032,13 @@ consisting of STR followed by an invisible left-to-right mark
   (if (string-match "\\cR" str)
       (concat str (propertize (string ?\x200e) 'invisible t))
     str))
   (if (string-match "\\cR" str)
       (concat str (propertize (string ?\x200e) 'invisible t))
     str))

+
+(defun string-greaterp (string1 string2)
+  "Return non-nil if STRING1 is greater than STRING2 in lexicographic order.
+Case is significant.
+Symbols are also allowed; their print names are used instead."
+  (string-lessp string2 string1))
+

 \f
 ;;;; Specifying things to do later.
 
 \f
 ;;;; Specifying things to do later.
 


@@ -3895,7 +4100,7 @@ If the feature is provided when evaluating code not associated with a
 file, FORM is evaluated immediately after the provide statement.
 
 Usually FILE is just a library name like \"font-lock\" or a feature name
 file, FORM is evaluated immediately after the provide statement.
 
 Usually FILE is just a library name like \"font-lock\" or a feature name

-like 'font-lock.
+like `font-lock'.

 
 This function makes or adds to an entry on `after-load-alist'."
   (declare (compiler-macro
 
 This function makes or adds to an entry on `after-load-alist'."
   (declare (compiler-macro


@@ -3950,7 +4155,8 @@ This function makes or adds to an entry on `after-load-alist'."
 (defmacro with-eval-after-load (file &rest body)
   "Execute BODY after FILE is loaded.
 FILE is normally a feature name, but it can also be a file name,
 (defmacro with-eval-after-load (file &rest body)
   "Execute BODY after FILE is loaded.
 FILE is normally a feature name, but it can also be a file name,

-in case that file does not provide any feature."
+in case that file does not provide any feature.  See `eval-after-load'
+for more details about the different forms of FILE and their semantics."

   (declare (indent 1) (debug t))
   `(eval-after-load ,file (lambda () ,@body)))
 
   (declare (indent 1) (debug t))
   `(eval-after-load ,file (lambda () ,@body)))
 


@@ -4057,9 +4263,10 @@ that can be added."
 
 (defun remove-from-invisibility-spec (element)
   "Remove ELEMENT from `buffer-invisibility-spec'."
 
 (defun remove-from-invisibility-spec (element)
   "Remove ELEMENT from `buffer-invisibility-spec'."

-  (if (consp buffer-invisibility-spec)
-      (setq buffer-invisibility-spec
-           (delete element buffer-invisibility-spec))))
+  (setq buffer-invisibility-spec
+        (if (consp buffer-invisibility-spec)
+           (delete element buffer-invisibility-spec)
+          (list t))))

 \f
 ;;;; Syntax tables.
 
 \f
 ;;;; Syntax tables.
 


@@ -4110,6 +4317,39 @@ If SYNTAX is nil, return nil."
 \f
 ;; Utility motion commands
 
 \f
 ;; Utility motion commands
 

+(defvar word-move-empty-char-table nil
+  "Used in `forward-word-strictly' and `backward-word-strictly'
+to countermand the effect of `find-word-boundary-function-table'.")
+
+(defun forward-word-strictly (&optional arg)
+  "Move point forward ARG words (backward if ARG is negative).
+If ARG is omitted or nil, move point forward one word.
+Normally returns t.
+If an edge of the buffer or a field boundary is reached, point is left there
+and the function returns nil.  Field boundaries are not noticed if
+`inhibit-field-text-motion' is non-nil.
+
+This function is like `forward-word', but it is not affected
+by `find-word-boundary-function-table'.  It is also not interactive."
+  (let ((find-word-boundary-function-table
+         (if (char-table-p word-move-empty-char-table)
+             word-move-empty-char-table
+           (setq word-move-empty-char-table (make-char-table nil)))))
+    (forward-word (or arg 1))))
+
+(defun backward-word-strictly (&optional arg)
+  "Move backward until encountering the beginning of a word.
+With argument ARG, do this that many times.
+If ARG is omitted or nil, move point backward one word.
+
+This function is like `forward-word', but it is not affected
+by `find-word-boundary-function-table'.  It is also not interactive."
+  (let ((find-word-boundary-function-table
+         (if (char-table-p word-move-empty-char-table)
+             word-move-empty-char-table
+           (setq word-move-empty-char-table (make-char-table nil)))))
+    (forward-word (- (or arg 1)))))
+

 ;;  Whitespace
 
 (defun forward-whitespace (arg)
 ;;  Whitespace
 
 (defun forward-whitespace (arg)


@@ -4672,14 +4912,14 @@ Usually the separator is \".\", but it can be any other string.")
 
 
 (defconst version-regexp-alist
 
 
 (defconst version-regexp-alist

-  '(("^[-_+ ]?snapshot$"                                 . -4)
+  '(("^[-._+ ]?snapshot$"                                 . -4)

     ;; treat "1.2.3-20050920" and "1.2-3" as snapshot releases
     ;; treat "1.2.3-20050920" and "1.2-3" as snapshot releases

-    ("^[-_+]$"                                           . -4)
+    ("^[-._+]$"                                           . -4)

     ;; treat "1.2.3-CVS" as snapshot release
     ;; treat "1.2.3-CVS" as snapshot release

-    ("^[-_+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)$" . -4)
-    ("^[-_+ ]?alpha$"                                    . -3)
-    ("^[-_+ ]?beta$"                                     . -2)
-    ("^[-_+ ]?\\(pre\\|rc\\)$"                           . -1))
+    ("^[-._+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)$" . -4)
+    ("^[-._+ ]?alpha$"                                    . -3)
+    ("^[-._+ ]?beta$"                                     . -2)
+    ("^[-._+ ]?\\(pre\\|rc\\)$"                           . -1))

   "Specify association between non-numeric version and its priority.
 
 This association is used to handle version string like \"1.0pre2\",
   "Specify association between non-numeric version and its priority.
 
 This association is used to handle version string like \"1.0pre2\",


@@ -4689,6 +4929,7 @@ non-numeric part of a version string to an integer.  For example:
    String Version    Integer List Version
    \"0.9snapshot\"     (0  9 -4)
    \"1.0-git\"         (1  0 -4)
    String Version    Integer List Version
    \"0.9snapshot\"     (0  9 -4)
    \"1.0-git\"         (1  0 -4)

+   \"1.0.cvs\"         (1  0 -4)

    \"1.0pre2\"         (1  0 -1 2)
    \"1.0PRE2\"         (1  0 -1 2)
    \"22.8beta3\"       (22 8 -2 3)
    \"1.0pre2\"         (1  0 -1 2)
    \"1.0PRE2\"         (1  0 -1 2)
    \"22.8beta3\"       (22 8 -2 3)


@@ -4728,41 +4969,47 @@ in `version-regexp-alist'.
 
 Examples of valid version syntax:
 
 
 Examples of valid version syntax:
 

-   1.0pre2   1.0.7.5   22.8beta3   0.9alpha1   6.9.30Beta
+   1.0pre2   1.0.7.5   22.8beta3   0.9alpha1   6.9.30Beta   2.4.snapshot   .5

 
 Examples of invalid version syntax:
 
 
 Examples of invalid version syntax:
 

-   1.0prepre2   1.0..7.5   22.8X3   alpha3.2   .5
+   1.0prepre2   1.0..7.5   22.8X3   alpha3.2

 
 Examples of version conversion:
 
    Version String    Version as a List of Integers
 
 Examples of version conversion:
 
    Version String    Version as a List of Integers

-   \"1.0.7.5\"         (1  0  7 5)
-   \"1.0pre2\"         (1  0 -1 2)
-   \"1.0PRE2\"         (1  0 -1 2)
-   \"22.8beta3\"       (22 8 -2 3)
-   \"22.8Beta3\"       (22 8 -2 3)
-   \"0.9alpha1\"       (0  9 -3 1)
+   \".5\"              (0 5)
+   \"0.9 alpha\"       (0  9 -3)

    \"0.9AlphA1\"       (0  9 -3 1)
    \"0.9AlphA1\"       (0  9 -3 1)

-   \"0.9alpha\"        (0  9 -3)

    \"0.9snapshot\"     (0  9 -4)
    \"1.0-git\"         (1  0 -4)
    \"0.9snapshot\"     (0  9 -4)
    \"1.0-git\"         (1  0 -4)

+   \"1.0.7.5\"         (1  0  7 5)
+   \"1.0.cvs\"         (1  0 -4)
+   \"1.0PRE2\"         (1  0 -1 2)
+   \"1.0pre2\"         (1  0 -1 2)
+   \"22.8 Beta3\"      (22 8 -2 3)
+   \"22.8beta3\"       (22 8 -2 3)

 
 See documentation for `version-separator' and `version-regexp-alist'."
 
 See documentation for `version-separator' and `version-regexp-alist'."

-  (or (and (stringp ver) (> (length ver) 0))
-      (error "Invalid version string: '%s'" ver))
+  (unless (stringp ver)
+    (error "Version must be a string"))

   ;; Change .x.y to 0.x.y
   (if (and (>= (length ver) (length version-separator))
           (string-equal (substring ver 0 (length version-separator))
                         version-separator))
       (setq ver (concat "0" ver)))
   ;; Change .x.y to 0.x.y
   (if (and (>= (length ver) (length version-separator))
           (string-equal (substring ver 0 (length version-separator))
                         version-separator))
       (setq ver (concat "0" ver)))

+  (unless (string-match-p "^[0-9]" ver)
+    (error "Invalid version syntax: `%s' (must start with a number)" ver))
+

   (save-match-data
     (let ((i 0)
          (case-fold-search t)          ; ignore case in matching
          lst s al)
   (save-match-data
     (let ((i 0)
          (case-fold-search t)          ; ignore case in matching
          lst s al)

+      ;; Parse the version-string up to a separator until there are none left

       (while (and (setq s (string-match "[0-9]+" ver i))
                  (= s i))
       (while (and (setq s (string-match "[0-9]+" ver i))
                  (= s i))

-       ;; handle numeric part
+        ;; Add the numeric part to the beginning of the version list;
+        ;; lst gets reversed at the end

        (setq lst (cons (string-to-number (substring ver i (match-end 0)))
                        lst)
              i   (match-end 0))
        (setq lst (cons (string-to-number (substring ver i (match-end 0)))
                        lst)
              i   (match-end 0))


@@ -4778,15 +5025,15 @@ See documentation for `version-separator' and `version-regexp-alist'."
              (setq al (cdr al)))
            (cond (al
                   (push (cdar al) lst))
              (setq al (cdr al)))
            (cond (al
                   (push (cdar al) lst))

-                 ;; Convert 22.3a to 22.3.1, 22.3b to 22.3.2, etc.
-                 ((string-match "^[-_+ ]?\\([a-zA-Z]\\)$" s)
+        ;; Convert 22.3a to 22.3.1, 22.3b to 22.3.2, etc., but only if
+        ;; the letter is the end of the version-string, to avoid
+        ;; 22.8X3 being valid
+        ((and (string-match "^[-._+ ]?\\([a-zA-Z]\\)$" s)
+           (= i (length ver)))

                   (push (- (aref (downcase (match-string 1 s)) 0) ?a -1)
                         lst))
                   (push (- (aref (downcase (match-string 1 s)) 0) ?a -1)
                         lst))

-                 (t (error "Invalid version syntax: '%s'" ver))))))
-      (if (null lst)
-         (error "Invalid version syntax: '%s'" ver)
-       (nreverse lst)))))
-
+                 (t (error "Invalid version syntax: `%s'" ver))))))
+    (nreverse lst))))

 
 (defun version-list-< (l1 l2)
   "Return t if L1, a list specification of a version, is lower than L2.
 
 (defun version-list-< (l1 l2)
   "Return t if L1, a list specification of a version, is lower than L2.


@@ -4909,6 +5156,26 @@ as a list.")
 
 \f
 ;;; Misc.
 
 \f
 ;;; Misc.

+
+(defvar definition-prefixes (make-hash-table :test 'equal)
+  "Hash table mapping prefixes to the files in which they're used.
+This can be used to automatically fetch not-yet-loaded definitions.
+More specifically, if there is a value of the form (FILES...) for a string PREFIX
+it means that the FILES define variables or functions with names that start
+with PREFIX.
+
+Note that it does not imply that all definitions starting with PREFIX can
+be found in those files.  E.g. if prefix is \"gnus-article-\" there might
+still be definitions of the form \"gnus-article-toto-titi\" in other files, which would
+presumably appear in this table under another prefix such as \"gnus-\"
+or \"gnus-article-toto-\".")
+
+(defun register-definition-prefixes (file prefixes)
+  "Register that FILE uses PREFIXES."
+  (dolist (prefix prefixes)
+    (puthash prefix (cons file (gethash prefix definition-prefixes))
+             definition-prefixes)))
+

 (defconst menu-bar-separator '("--")
   "Separator for menus.")
 
 (defconst menu-bar-separator '("--")
   "Separator for menus.")