]> code.delx.au - gnu-emacs/blobdiff - lisp/subr.el
Merge from origin/emacs-24
[gnu-emacs] / lisp / subr.el
index 585f9368c531a71502b0f329215a9291242efe16..53ad2729a10073f6e0447e2ccd121627b9bd2435 100644 (file)
@@ -169,7 +169,8 @@ change the list."
          ;; So we can use `pop' in the bootstrap before `gv' can be used.
          (list 'prog1 place (list 'setq place (list 'cdr place)))
        (gv-letplace (getter setter) place
-         `(prog1 ,getter ,(funcall setter `(cdr ,getter)))))))
+         (macroexp-let2 macroexp-copyable-p x getter
+           `(prog1 ,x ,(funcall setter `(cdr ,x))))))))
 
 (defmacro when (cond &rest body)
   "If COND yields non-nil, do BODY, else return nil.
@@ -2008,7 +2009,14 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
               (or (cdr (assq 'tool-bar global-map))
                   (lookup-key global-map [tool-bar])))
              map))
-         (aref (catch 'read-key (read-key-sequence-vector prompt nil t)) 0))
+          (let* ((keys
+                  (catch 'read-key (read-key-sequence-vector prompt nil t)))
+                 (key (aref keys 0)))
+            (if (and (> (length keys) 1)
+                     (memq key '(mode-line header-line
+                                 left-fringe right-fringe)))
+                (aref keys 1)
+              key)))
       (cancel-timer timer)
       (use-global-map old-global-map))))
 
@@ -2158,7 +2166,7 @@ keyboard-quit events while waiting for a valid input."
     char))
 
 (defun sit-for (seconds &optional nodisp obsolete)
-  "Perform redisplay, then wait for SECONDS seconds or until input is available.
+  "Redisplay, then wait for SECONDS seconds.  Stop when input is available.
 SECONDS may be a floating-point value.
 \(On operating systems that do not support waiting for fractions of a
 second, floating-point values are rounded down to the nearest integer.)
@@ -2176,7 +2184,7 @@ floating point support."
   (declare (advertised-calling-convention (seconds &optional nodisp) "22.1"))
   ;; This used to be implemented in C until the following discussion:
   ;; http://lists.gnu.org/archive/html/emacs-devel/2006-07/msg00401.html
-  ;; Then it was moved to C using an implementation based on an idle timer,
+  ;; Then it was moved here using an implementation based on an idle timer,
   ;; which was then replaced by the use of read-event.
   (if (numberp nodisp)
       (setq seconds (+ seconds (* 1e-3 nodisp))
@@ -4348,20 +4356,27 @@ use `called-interactively-p'."
 Normally, MAP is used only once, to look up the very next key.
 However, if the optional argument KEEP-PRED is t, MAP stays
 active if a key from MAP is used.  KEEP-PRED can also be a
-function of no arguments: if it returns non-nil, then MAP stays
-active.
+function of no arguments: it is called from `pre-command-hook' and
+if it returns non-nil, then MAP stays active.
 
 Optional arg ON-EXIT, if non-nil, specifies a function that is
 called, with no arguments, after MAP is deactivated.
 
 This uses `overriding-terminal-local-map' which takes precedence over all other
 keymaps.  As usual, if no match for a key is found in MAP, the normal key
-lookup sequence then continues."
-  (let ((clearfun (make-symbol "clear-transient-map")))
+lookup sequence then continues.
+
+This returns an \"exit function\", which can be called with no argument
+to deactivate this transient map, regardless of KEEP-PRED."
+  (let* ((clearfun (make-symbol "clear-transient-map"))
+         (exitfun
+          (lambda ()
+            (internal-pop-keymap map 'overriding-terminal-local-map)
+            (remove-hook 'pre-command-hook clearfun)
+            (when on-exit (funcall on-exit)))))
     ;; Don't use letrec, because equal (in add/remove-hook) would get trapped
     ;; in a cycle.
     (fset clearfun
-          (suspicious-object
           (lambda ()
             (with-demoted-errors "set-transient-map PCH: %S"
               (unless (cond
@@ -4382,15 +4397,10 @@ lookup sequence then continues."
                         (eq this-command
                             (lookup-key map (this-command-keys-vector))))
                        (t (funcall keep-pred)))
-                (internal-pop-keymap map 'overriding-terminal-local-map)
-                (remove-hook 'pre-command-hook clearfun)
-                 (when on-exit (funcall on-exit))
-                 ;; Comment out the fset if you want to debug the GC bug.
-;;;            (fset clearfun nil)
-;;;             (set clearfun nil)
-                 )))))
+                (funcall exitfun)))))
     (add-hook 'pre-command-hook clearfun)
-    (internal-push-keymap map 'overriding-terminal-local-map)))
+    (internal-push-keymap map 'overriding-terminal-local-map)
+    exitfun))
 
 ;;;; Progress reporters.
 
@@ -4498,11 +4508,10 @@ NEW-MESSAGE, if non-nil, sets a new message for the reporter."
         (min-value    (aref parameters 1))
         (max-value    (aref parameters 2))
         (text         (aref parameters 3))
-        (current-time (float-time))
         (enough-time-passed
          ;; See if enough time has passed since the last update.
          (or (not update-time)
-             (when (>= current-time update-time)
+             (when (>= (float-time) update-time)
                ;; Calculate time for the next update
                (aset parameters 0 (+ update-time (aref parameters 5)))))))
     (cond ((and min-value max-value)