]> code.delx.au - gnu-emacs/blobdiff - lisp/subr.el
(read-number): New function.
[gnu-emacs] / lisp / subr.el
index c03b2ff0a9880a118a709dbcc92c90a34606009b..2c39a8447cf4090ee1b4b601d53122a4e135fb10 100644 (file)
@@ -1,6 +1,6 @@
 ;;; subr.el --- basic lisp subroutines for Emacs
 
-;; Copyright (C) 1985, 86, 92, 94, 95, 99, 2000, 2001, 2002, 2003
+;; Copyright (C) 1985, 86, 92, 94, 95, 99, 2000, 2001, 2002, 03, 2004
 ;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
@@ -62,6 +62,20 @@ The return value of this function is not used."
 
 (defalias 'not 'null)
 
+(defmacro noreturn (form)
+  "Evaluates FORM, with the expectation that the evaluation will signal an error
+instead of returning to its caller.  If FORM does return, an error is
+signalled."
+  `(prog1 ,form
+     (error "Form marked with `noreturn' did return")))
+
+(defmacro 1value (form)
+  "Evaluates FORM, with the expectation that all the same value will be returned
+from all evaluations of FORM.  This is the global do-nothing
+version of `1value'.  There is also `testcover-1value' that
+complains if FORM ever does return differing values."
+  form)
+
 (defmacro lambda (&rest cdr)
   "Return a lambda expression.
 A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is
@@ -85,6 +99,7 @@ BODY should be a list of Lisp expressions."
   "Add NEWELT to the list stored in the symbol LISTNAME.
 This is equivalent to (setq LISTNAME (cons NEWELT LISTNAME)).
 LISTNAME must be a symbol."
+  (declare (debug (form sexp)))
   (list 'setq listname
        (list 'cons newelt listname)))
 
@@ -93,6 +108,7 @@ LISTNAME must be a symbol."
 LISTNAME must be a symbol whose value is a list.
 If the value is nil, `pop' returns nil but does not actually
 change the list."
+  (declare (debug (sexp)))
   (list 'car
        (list 'prog1 listname
              (list 'setq listname (list 'cdr listname)))))
@@ -112,7 +128,7 @@ change the list."
 Evaluate BODY with VAR bound to each car from LIST, in turn.
 Then evaluate RESULT to get return value, default nil.
 
-\(dolist (VAR LIST [RESULT]) BODY...)"
+\(fn (VAR LIST [RESULT]) BODY...)"
   (declare (indent 1) (debug ((symbolp form &optional form) body)))
   (let ((temp (make-symbol "--dolist-temp--")))
     `(let ((,temp ,(nth 1 spec))
@@ -130,7 +146,7 @@ Evaluate BODY with VAR bound to successive integers running from 0,
 inclusive, to COUNT, exclusive.  Then evaluate RESULT to get
 the return value (nil if RESULT is omitted).
 
-\(dotimes (VAR COUNT [RESULT]) BODY...)"
+\(fn (VAR COUNT [RESULT]) BODY...)"
   (declare (indent 1) (debug dolist))
   (let ((temp (make-symbol "--dotimes-temp--"))
        (start 0)
@@ -142,6 +158,12 @@ the return value (nil if RESULT is omitted).
         (setq ,(car spec) (1+ ,(car spec))))
        ,@(cdr (cdr spec)))))
 
+(defmacro declare (&rest specs)
+  "Do not evaluate any arguments and return nil.
+Treated as a declaration when used at the right place in a
+`defmacro' form.  \(See Info anchor `(elisp)Definition of declare'."
+  nil)
+
 (defsubst caar (x)
   "Return the car of the car of X."
   (car (car x)))
@@ -187,22 +209,54 @@ If N is bigger than the length of X, return X."
           (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
           x))))
 
+(defun delete-dups (list)
+  "Destructively remove `equal' duplicates from LIST.
+Store the result in LIST and return it.  LIST must be a proper list.
+Of several `equal' occurrences of an element in LIST, the first
+one is kept."
+  (let ((tail list))
+    (while tail
+      (setcdr tail (delete (car tail) (cdr tail)))
+      (setq tail (cdr tail))))
+  list)
+
 (defun number-sequence (from &optional to inc)
   "Return a sequence of numbers from FROM to TO (both inclusive) as a list.
-INC is the increment used between numbers in the sequence.
-So, the Nth element of the list is (+ FROM (* N INC)) where N counts from
-zero.
-If INC is nil, it defaults to 1 (one).
-If TO is nil, it defaults to FROM.
-If TO is less than FROM, the value is nil.
-Note that FROM, TO and INC can be integer or float."
-  (if (not to)
+INC is the increment used between numbers in the sequence and defaults to 1.
+So, the Nth element of the list is \(+ FROM \(* N INC)) where N counts from
+zero.  TO is only included if there is an N for which TO = FROM + N * INC.
+If TO is nil or numerically equal to FROM, return \(FROM).
+If INC is positive and TO is less than FROM, or INC is negative
+and TO is larger than FROM, return nil.
+If INC is zero and TO is neither nil nor numerically equal to
+FROM, signal an error.
+
+This function is primarily designed for integer arguments.
+Nevertheless, FROM, TO and INC can be integer or float.  However,
+floating point arithmetic is inexact.  For instance, depending on
+the machine, it may quite well happen that
+\(number-sequence 0.4 0.6 0.2) returns the one element list \(0.4),
+whereas \(number-sequence 0.4 0.8 0.2) returns a list with three
+elements.  Thus, if some of the arguments are floats and one wants
+to make sure that TO is included, one may have to explicitly write
+TO as \(+ FROM \(* N INC)) or use a variable whose value was
+computed with this exact expression.  Alternatively, you can,
+of course, also replace TO with a slightly larger value
+\(or a slightly more negative value if INC is negative)."
+  (if (or (not to) (= from to))
       (list from)
     (or inc (setq inc 1))
-    (let (seq)
-      (while (<= from to)
-       (setq seq (cons from seq)
-             from (+ from inc)))
+    (when (zerop inc) (error "The increment can not be zero"))
+    (let (seq (n 0) (next from))
+      (if (> inc 0)
+          (while (<= next to)
+            (setq seq (cons next seq)
+                  n (1+ n)
+                  next (+ from (* n inc))))
+        (while (>= next to)
+          (setq seq (cons next seq)
+                n (1+ n)
+                next (+ from (* n inc)))))
       (nreverse seq))))
 
 (defun remove (elt seq)
@@ -261,27 +315,19 @@ If TEST is omitted or nil, `equal' is used."
       (setq tail (cdr tail)))
     value))
 
+(make-obsolete 'assoc-ignore-case 'assoc-string)
 (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."
-  (let (element)
-    (while (and alist (not element))
-      (if (eq t (compare-strings key 0 nil (car (car alist)) 0 nil t))
-         (setq element (car alist)))
-      (setq alist (cdr alist)))
-    element))
+  (assoc-string key alist t))
 
+(make-obsolete 'assoc-ignore-representation 'assoc-string)
 (defun assoc-ignore-representation (key alist)
   "Like `assoc', but ignores differences in text representation.
 KEY must be a string.
 Unibyte strings are converted to multibyte for comparison."
-  (let (element)
-    (while (and alist (not element))
-      (if (eq t (compare-strings key 0 nil (car (car alist)) 0 nil))
-         (setq element (car alist)))
-      (setq alist (cdr alist)))
-    element))
+  (assoc-string key alist nil))
 
 (defun member-ignore-case (elt list)
   "Like `member', but ignores differences in case and text representation.
@@ -636,7 +682,8 @@ If EVENT is a mouse press or a mouse click, this returns the location
 of the event.
 If EVENT is a drag, this returns the drag's starting position.
 The return value is of the form
-   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
+   (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
+    IMAGE (DX . DY) (WIDTH . HEIGHT))
 The `posn-' functions access elements of such lists."
   (if (consp event) (nth 1 event)
     (list (selected-window) (point) '(0 . 0) 0)))
@@ -645,7 +692,8 @@ The `posn-' functions access elements of such lists."
   "Return the ending location of EVENT.  EVENT should be a click or drag event.
 If EVENT is a click event, this function is the same as `event-start'.
 The return value is of the form
-   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
+   (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
+    IMAGE (DX . DY) (WIDTH . HEIGHT))
 The `posn-' functions access elements of such lists."
   (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
     (list (selected-window) (point) '(0 . 0) 0)))
@@ -657,61 +705,107 @@ The return value is a positive integer."
 
 (defsubst posn-window (position)
   "Return the window in POSITION.
-POSITION should be a list of the form
-   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions."
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
   (nth 0 position))
 
+(defsubst posn-area (position)
+  "Return the window area recorded in POSITION, or nil for the text area.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+  (let ((area (if (consp (nth 1 position))
+                 (car (nth 1 position))
+               (nth 1 position))))
+    (and (symbolp area) area)))
+
 (defsubst posn-point (position)
   "Return the buffer location in POSITION.
-POSITION should be a list of the form
-   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions."
-  (if (consp (nth 1 position))
-      (car (nth 1 position))
-    (nth 1 position)))
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+  (or (nth 5 position)
+      (if (consp (nth 1 position))
+         (car (nth 1 position))
+       (nth 1 position))))
 
 (defsubst posn-x-y (position)
   "Return the x and y coordinates in POSITION.
-POSITION should be a list of the form
-   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions."
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
   (nth 2 position))
 
 (defun posn-col-row (position)
-  "Return the column and row in POSITION, measured in characters.
-POSITION should be a list of the form
-   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions.
+  "Return the nominal column and row in POSITION, measured in characters.
+The column and row values are approximations calculated from the x
+and y coordinates in POSITION and the frame's default character width
+and height.
 For a scroll-bar event, the result column is 0, and the row
-corresponds to the vertical position of the click in the scroll bar."
-  (let* ((pair   (nth 2 position))
-        (window (posn-window position)))
-    (if (eq (if (consp (nth 1 position))
-               (car (nth 1 position))
-             (nth 1 position))
-           'vertical-scroll-bar)
-       (cons 0 (scroll-bar-scale pair (1- (window-height window))))
-      (if (eq (if (consp (nth 1 position))
-                 (car (nth 1 position))
-               (nth 1 position))
-             'horizontal-scroll-bar)
-         (cons (scroll-bar-scale pair (window-width window)) 0)
-       (let* ((frame (if (framep window) window (window-frame window)))
-              (x (/ (car pair) (frame-char-width frame)))
-              (y (/ (cdr pair) (+ (frame-char-height frame)
-                                  (or (frame-parameter frame 'line-spacing)
-                                      default-line-spacing
-                                      0)))))
-         (cons x y))))))
+corresponds to the vertical position of the click in the scroll bar.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+  (let* ((pair   (posn-x-y position))
+        (window (posn-window position))
+        (area   (posn-area position)))
+    (cond
+     ((null window)
+      '(0 . 0))
+     ((eq area 'vertical-scroll-bar)
+      (cons 0 (scroll-bar-scale pair (1- (window-height window)))))
+     ((eq area 'horizontal-scroll-bar)
+      (cons (scroll-bar-scale pair (window-width window)) 0))
+     (t
+      (let* ((frame (if (framep window) window (window-frame window)))
+            (x (/ (car pair) (frame-char-width frame)))
+            (y (/ (cdr pair) (+ (frame-char-height frame)
+                                (or (frame-parameter frame 'line-spacing)
+                                    default-line-spacing
+                                    0)))))
+       (cons x y))))))
+
+(defun posn-actual-col-row (position)
+  "Return the actual column and row in POSITION, measured in characters.
+These are the actual row number in the window 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.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+  (nth 6 position))
 
 (defsubst posn-timestamp (position)
   "Return the timestamp of POSITION.
-POSITION should be a list of the form
-   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions."
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
   (nth 3 position))
 
+(defsubst posn-string (position)
+  "Return the string object of POSITION, or nil if a buffer position.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+  (nth 4 position))
+
+(defsubst posn-image (position)
+  "Return the image object of POSITION, or nil if a not an image.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+  (nth 7 position))
+
+(defsubst posn-object (position)
+  "Return the object (image or string) of POSITION.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+  (or (posn-image position) (posn-string position)))
+
+(defsubst posn-object-x-y (position)
+  "Return the x and y coordinates relative to the object of POSITION.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+  (nth 8 position))
+
+(defsubst posn-object-width-height (position)
+  "Return the pixel width and height of the object of POSITION.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+  (nth 9 position))
+
 \f
 ;;;; Obsolescent names for functions.
 
@@ -876,31 +970,32 @@ FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
 list of hooks to run in HOOK, then nothing is done.  See `add-hook'.
 
 The optional third argument, LOCAL, if non-nil, says to modify
-the hook's buffer-local value rather than its default value.
-This makes the hook buffer-local if needed."
+the hook's buffer-local value rather than its default value."
   (or (boundp hook) (set hook nil))
   (or (default-boundp hook) (set-default hook nil))
-  (if local (unless (local-variable-if-set-p hook)
-             (set (make-local-variable hook) (list t)))
+  ;; Do nothing if LOCAL is t but this hook has no local binding.
+  (unless (and local (not (local-variable-p hook)))
     ;; Detect the case where make-local-variable was used on a hook
     ;; and do what we used to do.
-    (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook)))
-      (setq local t)))
-  (let ((hook-value (if local (symbol-value hook) (default-value hook))))
-    ;; Remove the function, for both the list and the non-list cases.
-    (if (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
-       (if (equal hook-value function) (setq hook-value nil))
-      (setq hook-value (delete function (copy-sequence hook-value))))
-    ;; If the function is on the global hook, we need to shadow it locally
-    ;;(when (and local (member function (default-value hook))
-    ;;        (not (member (cons 'not function) hook-value)))
-    ;;  (push (cons 'not function) hook-value))
-    ;; Set the actual variable
-    (if (not local)
-       (set-default hook hook-value)
-      (if (equal hook-value '(t))
-         (kill-local-variable hook)
-       (set hook hook-value)))))
+    (when (and (local-variable-p hook)
+              (not (and (consp (symbol-value hook))
+                        (memq t (symbol-value hook)))))
+      (setq local t))
+    (let ((hook-value (if local (symbol-value hook) (default-value hook))))
+      ;; Remove the function, for both the list and the non-list cases.
+      (if (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
+         (if (equal hook-value function) (setq hook-value nil))
+       (setq hook-value (delete function (copy-sequence hook-value))))
+      ;; If the function is on the global hook, we need to shadow it locally
+      ;;(when (and local (member function (default-value hook))
+      ;;              (not (member (cons 'not function) hook-value)))
+      ;;  (push (cons 'not function) hook-value))
+      ;; Set the actual variable
+      (if (not local)
+         (set-default hook hook-value)
+       (if (equal hook-value '(t))
+           (kill-local-variable hook)
+         (set hook hook-value))))))
 
 (defun add-to-list (list-var element &optional append)
   "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
@@ -1178,10 +1273,10 @@ Optional DEFAULT is a default password to use instead of empty input."
                (second (read-passwd "Confirm password: " nil default)))
            (if (equal first second)
                (progn
-                 (and (arrayp second) (fillarray second ?\0))
+                 (and (arrayp second) (clear-string second))
                  (setq success first))
-             (and (arrayp first) (fillarray first ?\0))
-             (and (arrayp second) (fillarray second ?\0))
+             (and (arrayp first) (clear-string first))
+             (and (arrayp second) (clear-string second))
              (message "Password not repeated accurately; please start over")
              (sit-for 1))))
        success)
@@ -1197,21 +1292,42 @@ Optional DEFAULT is a default password to use instead of empty input."
        (clear-this-command-keys)
        (if (= c ?\C-u)
            (progn
-             (and (arrayp pass) (fillarray pass ?\0))
+             (and (arrayp pass) (clear-string pass))
              (setq pass ""))
          (if (and (/= c ?\b) (/= c ?\177))
              (let* ((new-char (char-to-string c))
                     (new-pass (concat pass new-char)))
-               (and (arrayp pass) (fillarray pass ?\0))
-               (fillarray new-char ?\0)
+               (and (arrayp pass) (clear-string pass))
+               (clear-string new-char)
                (setq c ?\0)
                (setq pass new-pass))
            (if (> (length pass) 0)
                (let ((new-pass (substring pass 0 -1)))
-                 (and (arrayp pass) (fillarray pass ?\0))
+                 (and (arrayp pass) (clear-string pass))
                  (setq pass new-pass))))))
       (message nil)
       (or pass default ""))))
+
+;; This should be used by `call-interactively' for `n' specs.
+(defun read-number (prompt &optional default)
+  (let ((n nil))
+    (when default
+      (setq prompt
+           (if (string-match "\\(\\):[^:]*" prompt)
+               (replace-match (format " [%s]" default) t t prompt 1)
+             (concat prompt (format " [%s] " default)))))
+    (while
+       (progn
+         (let ((str (read-from-minibuffer prompt nil nil nil nil
+                                          (number-to-string default))))
+           (setq n (cond
+                    ((zerop (length str)) default)
+                    ((stringp str) (read str)))))
+         (unless (numberp n)
+           (message "Please enter a number.")
+           (sit-for 1)
+           t)))
+    n))
 \f
 ;;; Atomic change groups.
 
@@ -1319,8 +1435,10 @@ This finishes the change group by reverting all of its changes."
 (defalias 'redraw-modeline 'force-mode-line-update)
 
 (defun force-mode-line-update (&optional all)
-  "Force the mode line of the current buffer to be redisplayed.
-With optional non-nil ALL, force redisplay of all mode lines."
+  "Force redisplay of the current buffer's mode line and header line.
+With optional non-nil ALL, force redisplay of all mode lines and
+header lines.  This function also forces recomputation of the
+menu bar menus and the frame title."
   (if all (save-excursion (set-buffer (other-buffer))))
   (set-buffer-modified-p (buffer-modified-p)))
 
@@ -1495,7 +1613,18 @@ Replaces `category' properties with their defined properties."
 (defvar yank-undo-function)
 
 (defun insert-for-yank (string)
+  "Calls `insert-for-yank-1' repetitively for each `yank-handler' segment.
+
+See `insert-for-yank-1' for more details."
+  (let (to)
+    (while (setq to (next-single-property-change 0 'yank-handler string))
+      (insert-for-yank-1 (substring string 0 to))
+      (setq string (substring string to))))
+  (insert-for-yank-1 string))
+
+(defun insert-for-yank-1 (string)
   "Insert STRING at point, stripping some text properties.
+
 Strip text properties from the inserted text according to
 `yank-excluded-properties'.  Otherwise just like (insert STRING).
 
@@ -1548,6 +1677,8 @@ BUFFER may be a buffer or a buffer name.  Arguments START and END are
 character numbers specifying the substring.  They default to the
 beginning and the end of BUFFER.  Strip text properties from the
 inserted text according to `yank-excluded-properties'."
+  ;; Since the buffer text should not normally have yank-handler properties,
+  ;; there is no need to handle them here.
   (let ((opoint (point)))
     (insert-buffer-substring buf start end)
     (remove-yank-excluded-properties opoint (point))))
@@ -1620,16 +1751,30 @@ See also `with-temp-buffer'."
 (defmacro with-selected-window (window &rest body)
   "Execute the forms in BODY with WINDOW as the selected window.
 The value returned is the value of the last form in BODY.
+This does not alter the buffer list ordering.
 See also `with-temp-buffer'."
   (declare (indent 1) (debug t))
-  `(save-selected-window
-     (select-window ,window 'norecord)
-     ,@body))
+  ;; Most of this code is a copy of save-selected-window.
+  `(let ((save-selected-window-window (selected-window))
+        (save-selected-window-alist
+         (mapcar (lambda (frame) (list frame (frame-selected-window frame)))
+                 (frame-list))))
+     (unwind-protect
+        (progn (select-window ,window 'norecord)
+               ,@body)
+       (dolist (elt save-selected-window-alist)
+        (and (frame-live-p (car elt))
+             (window-live-p (cadr elt))
+             (set-frame-selected-window (car elt) (cadr elt))))
+       (if (window-live-p save-selected-window-window)
+          ;; This is where the code differs from save-selected-window.
+          (select-window save-selected-window-window 'norecord)))))
 
 (defmacro with-temp-file (file &rest body)
   "Create a new buffer, evaluate BODY there, and write the buffer to FILE.
 The value returned is the value of the last form in BODY.
 See also `with-temp-buffer'."
+  (declare (debug t))
   (let ((temp-file (make-symbol "temp-file"))
        (temp-buffer (make-symbol "temp-buffer")))
     `(let ((,temp-file ,file)
@@ -1652,6 +1797,7 @@ The value returned is the value of the last form in BODY.
 MESSAGE is written to the message log buffer if `message-log-max' is non-nil.
 If MESSAGE is nil, the echo area and message log buffer are unchanged.
 Use a MESSAGE of \"\" to temporarily clear the echo area."
+  (declare (debug t))
   (let ((current-message (make-symbol "current-message"))
        (temp-message (make-symbol "with-temp-message")))
     `(let ((,temp-message ,message)
@@ -1724,6 +1870,7 @@ in BODY."
 (defvar delayed-mode-hooks nil
   "List of delayed mode hooks waiting to be run.")
 (make-variable-buffer-local 'delayed-mode-hooks)
+(put 'delay-mode-hooks 'permanent-local t)
 
 (defun run-mode-hooks (&rest hooks)
   "Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS.
@@ -1741,6 +1888,7 @@ Major mode functions should use this."
 (defmacro delay-mode-hooks (&rest body)
   "Execute BODY, but delay any `run-mode-hooks'.
 Only affects hooks run in the current buffer."
+  (declare (debug t))
   `(progn
      (make-local-variable 'delay-mode-hooks)
      (let ((delay-mode-hooks t))
@@ -1761,6 +1909,7 @@ Uses the `derived-mode-parent' property of the symbol to trace backwards."
 The syntax table of the current buffer is saved, BODY is evaluated, and the
 saved table is restored, even in case of an abnormal exit.
 Value is what BODY returns."
+  (declare (debug t))
   (let ((old-table (make-symbol "table"))
        (old-buffer (make-symbol "buffer")))
     `(let ((,old-table (syntax-table))
@@ -1772,6 +1921,46 @@ Value is what BODY returns."
         (save-current-buffer
           (set-buffer ,old-buffer)
           (set-syntax-table ,old-table))))))
+
+(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'."
+  (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)))
+         (cond
+          ((eq ,mode t) (all-completions ,string (,fun ,string) ,predicate))
+          ((not ,mode) (try-completion ,string (,fun ,string) ,predicate))
+          (t (test-completion ,string (,fun ,string) ,predicate)))))))
+
+(defmacro lazy-completion-table (var fun &rest args)
+  "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 arguments
+ARGS.  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."
+  (let ((str (make-symbol "string")))
+    `(dynamic-completion-table
+      (lambda (,str)
+        (unless (listp ,var)
+          (setq ,var (funcall ',fun ,@args)))
+        ,var))))
 \f
 ;;; Matching and substitution
 
@@ -1813,13 +2002,19 @@ Zero means the entire text matched by the whole regexp or whole string.
 STRING should be given if the last search was by `string-match' on STRING."
   (if (match-beginning num)
       (if string
-         (let ((result
-                (substring string (match-beginning num) (match-end num))))
-           (set-text-properties 0 (length result) nil result)
-           result)
+         (substring-no-properties string (match-beginning num)
+                                  (match-end num))
        (buffer-substring-no-properties (match-beginning num)
                                        (match-end num)))))
 
+(defun looking-back (regexp &optional limit)
+  "Return non-nil if text before point matches regular expression REGEXP.
+Like `looking-at' except backwards and slower.
+LIMIT if non-nil speeds up the search by specifying how far back the
+match can start."
+  (save-excursion
+    (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)))
+
 (defconst split-string-default-separators "[ \f\t\n\r\v]+"
   "The default value of separators for `split-string'.
 
@@ -2066,7 +2261,10 @@ configuration."
        (eq (car object) 'frame-configuration)))
 
 (defun functionp (object)
-  "Non-nil iff OBJECT is a type of object that can be called as a function."
+  "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."
   (or (and (symbolp object) (fboundp object)
           (condition-case nil
               (setq object (indirect-function object))
@@ -2152,7 +2350,8 @@ If SUFFIX is non-nil, add that at the end of the file name."
 ;; isearch-mode is deliberately excluded, since you should
 ;; not call it yourself.
 (defvar minor-mode-list '(auto-save-mode auto-fill-mode abbrev-mode
-                                        overwrite-mode view-mode)
+                                        overwrite-mode view-mode
+                                         hs-minor-mode)
   "List of all minor mode functions.")
 
 (defun add-minor-mode (toggle name &optional keymap after toggle-fun)
@@ -2381,4 +2580,5 @@ The properties used on SYMBOL are `composefunc', `sendfunc',
   (put symbol 'abortfunc (or abortfunc 'kill-buffer))
   (put symbol 'hookvar (or hookvar 'mail-send-hook)))
 
+;;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc
 ;;; subr.el ends here