]> code.delx.au - gnu-emacs/blobdiff - lisp/subr.el
Merge from trunk
[gnu-emacs] / lisp / subr.el
index 59e00bfbeb291fe9347caf151568d10ea5ba6a65..d7df38626bd35e0c318af7967fe3b263263442a3 100644 (file)
@@ -5,6 +5,7 @@
 
 ;; Maintainer: FSF
 ;; Keywords: internal
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
@@ -219,6 +220,7 @@ Treated as a declaration when used at the right place in a
 (defmacro ignore-errors (&rest body)
   "Execute BODY; if an error occurs, return nil.
 Otherwise, return result of last form in BODY."
+  (declare (debug t) (indent 0))
   `(condition-case nil (progn ,@body) (error nil)))
 \f
 ;;;; Basic Lisp functions.
@@ -237,7 +239,7 @@ letter but *do not* end with a period.  Please follow this convention
 for the sake of consistency."
   (while t
     (signal 'error (list (apply 'format args)))))
-(set-advertised-calling-convention 'error '(string &rest args))
+(set-advertised-calling-convention 'error '(string &rest args) "23.1")
 
 ;; We put this here instead of in frame.el so that it's defined even on
 ;; systems where frame.el isn't loaded.
@@ -427,6 +429,12 @@ Non-strings in LIST are ignored."
     (setq list (cdr list)))
   list)
 
+(defmacro with-lexical-binding (&rest body)
+  "Execute the statements in BODY using lexical binding."
+  `(let ((internal-interpreter-environment internal-interpreter-environment))
+     (setq internal-interpreter-environment '(t))
+     ,@body))
+
 (defun assq-delete-all (key alist)
   "Delete from ALIST all elements whose car is `eq' to KEY.
 Return the modified alist.
@@ -1037,9 +1045,10 @@ is converted into a string by expressing it in decimal."
 (make-obsolete 'make-variable-frame-local
               "explicitly check for a frame-parameter instead." "22.2")
 (make-obsolete 'interactive-p 'called-interactively-p "23.2")
-(set-advertised-calling-convention 'called-interactively-p '(kind))
+(set-advertised-calling-convention 'called-interactively-p '(kind) "23.1")
 (set-advertised-calling-convention
- 'all-completions '(string collection &optional predicate))
+ 'all-completions '(string collection &optional predicate) "23.1")
+(set-advertised-calling-convention 'unintern '(name obarray) "23.3")
 \f
 ;;;; Obsolescence declarations for variables, and aliases.
 
@@ -1055,7 +1064,6 @@ is converted into a string by expressing it in decimal."
 (make-obsolete-variable 'default-line-spacing 'line-spacing "23.2")
 (make-obsolete-variable 'default-abbrev-mode 'abbrev-mode "23.2")
 (make-obsolete-variable 'default-ctl-arrow 'ctl-arrow "23.2")
-(make-obsolete-variable 'default-direction-reversed 'direction-reversed "23.2")
 (make-obsolete-variable 'default-truncate-lines 'truncate-lines "23.2")
 (make-obsolete-variable 'default-left-margin 'left-margin "23.2")
 (make-obsolete-variable 'default-tab-width 'tab-width "23.2")
@@ -1090,7 +1098,11 @@ is converted into a string by expressing it in decimal."
 (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")
+(defconst directory-sep-char ?/
+  "Directory separator character for built-in functions that return file names.
+The value is always ?/.")
+(make-obsolete-variable 'directory-sep-char "do not use it, just use `/'." "21.1")
+
 (make-obsolete-variable
  'mode-line-inverse-video
  "use the appropriate faces instead."
@@ -1478,8 +1490,7 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label."
              (let ((rest (cdr found)))
                (setcdr found nil)
                (nconc found (list (list toggle name)) rest))
-           (setq minor-mode-alist (cons (list toggle name)
-                                        minor-mode-alist)))))))
+           (push (list toggle name) minor-mode-alist))))))
   ;; Add the toggle to the minor-modes menu if requested.
   (when (get toggle :included)
     (define-key mode-line-mode-menu
@@ -1508,8 +1519,7 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label."
              (let ((rest (cdr found)))
                (setcdr found nil)
                (nconc found (list (cons toggle keymap)) rest))
-           (setq minor-mode-map-alist (cons (cons toggle keymap)
-                                            minor-mode-map-alist))))))))
+           (push (cons toggle keymap) minor-mode-map-alist)))))))
 \f
 ;;; Load history
 
@@ -1627,6 +1637,7 @@ Return nil if there isn't one."
              load-elt (and loads (car loads)))))
     load-elt))
 
+(put 'eval-after-load 'lisp-indent-function 1)
 (defun eval-after-load (file form)
   "Arrange that, if FILE is ever loaded, FORM will be run at that time.
 If FILE is already loaded, evaluate FORM right now.
@@ -1817,6 +1828,7 @@ When there's an ambiguity because the key looks like the prefix of
 some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
   (let ((overriding-terminal-local-map read-key-empty-map)
        (overriding-local-map nil)
+        (echo-keystrokes 0)
        (old-global-map (current-global-map))
         (timer (run-with-idle-timer
                 ;; Wait long enough that Emacs has the time to receive and
@@ -1841,7 +1853,12 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
                       (throw 'read-key keys)))))))
     (unwind-protect
         (progn
-         (use-global-map read-key-empty-map)
+         (use-global-map
+           (let ((map (make-sparse-keymap)))
+             ;; Don't hide the menu-bar and tool-bar entries.
+             (define-key map [menu-bar] (lookup-key global-map [menu-bar]))
+             (define-key map [tool-bar] (lookup-key global-map [tool-bar]))
+             map))
          (aref (catch 'read-key (read-key-sequence-vector prompt nil t)) 0))
       (cancel-timer timer)
       (use-global-map old-global-map))))
@@ -1873,12 +1890,11 @@ any other non-digit terminates the character code and is then used as input."))
       ;; Note: `read-char' does it using the `ascii-character' property.
       ;; We should try and use read-key instead.
       (let ((translation (lookup-key local-function-key-map (vector char))))
-       (if (arrayp translation)
-           (setq translated (aref translation 0))))
-      (setq translated
-           (if (integerp char)
-               (char-resolve-modifiers char)
-             char))
+       (setq translated (if (arrayp translation)
+                            (aref translation 0)
+                          char)))
+      (if (integerp translated)
+         (setq translated (char-resolve-modifiers translated)))
       (cond ((null translated))
            ((not (integerp translated))
             (setq unread-command-events (list char)
@@ -2055,7 +2071,7 @@ floating point support."
                (setq read (cons t read)))
            (push read unread-command-events)
            nil))))))
-(set-advertised-calling-convention 'sit-for '(seconds &optional nodisp))
+(set-advertised-calling-convention 'sit-for '(seconds &optional nodisp) "22.1")
 \f
 ;;; Atomic change groups.
 
@@ -2583,7 +2599,7 @@ discouraged."
   (start-process name buffer shell-file-name shell-command-switch
                 (mapconcat 'identity args " ")))
 (set-advertised-calling-convention 'start-process-shell-command
-                                   '(name buffer command))
+                                   '(name buffer command) "23.1")
 
 (defun start-file-process-shell-command (name buffer &rest args)
   "Start a program in a subprocess.  Return the process object for it.
@@ -2594,7 +2610,7 @@ Similar to `start-process-shell-command', but calls `start-file-process'."
    (if (file-remote-p default-directory) "-c" shell-command-switch)
    (mapconcat 'identity args " ")))
 (set-advertised-calling-convention 'start-file-process-shell-command
-                                   '(name buffer command))
+                                   '(name buffer command) "23.1")
 
 (defun call-process-shell-command (command &optional infile buffer display
                                           &rest args)
@@ -2705,7 +2721,7 @@ nor the buffer list."
   "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))
+  (declare (indent 1) (debug t))
   (let ((temp-file (make-symbol "temp-file"))
        (temp-buffer (make-symbol "temp-buffer")))
     `(let ((,temp-file ,file)
@@ -2727,7 +2743,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))
+  (declare (debug t) (indent 1))
   (let ((current-message (make-symbol "current-message"))
        (temp-message (make-symbol "with-temp-message")))
     `(let ((,temp-message ,message)
@@ -2757,7 +2773,7 @@ See also `with-temp-file' and `with-output-to-string'."
                 (kill-buffer ,temp-buffer)))))))
 
 (defmacro with-silent-modifications (&rest body)
-  "Execute BODY, pretending it does not modifies the buffer.
+  "Execute BODY, pretending it does not modify the buffer.
 If BODY performs real modifications to the buffer's text, other
 than cosmetic ones, undo data may become corrupted.
 Typically used around modifications of text-properties which do not really
@@ -3219,7 +3235,7 @@ that can be added."
 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))
+  (declare (debug t) (indent 1))
   (let ((old-table (make-symbol "table"))
        (old-buffer (make-symbol "buffer")))
     `(let ((,old-table (syntax-table))
@@ -3349,6 +3365,56 @@ clone should be incorporated in the clone."
     (overlay-put ol2 'evaporate t)
     (overlay-put ol2 'text-clones dups)))
 \f
+;;;; Misc functions moved over from the C side.
+
+(defun y-or-n-p (prompt)
+  "Ask user a \"y or n\" question.  Return t if answer is \"y\".
+The argument 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.
+No confirmation of the answer is requested; a single character is enough.
+Also accepts Space to mean yes, or Delete to mean no.  \(Actually, it uses
+the bindings in `query-replace-map'; see the documentation of that variable
+for more information.  In this case, the useful bindings are `act', `skip',
+`recenter', and `quit'.\)
+
+Under a windowing system a dialog box will be used if `last-nonmenu-event'
+is nil and `use-dialog-box' is non-nil."
+  ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
+  ;; where all the keys were unbound (i.e. it somehow got triggered
+  ;; within read-key, apparently).  I had to kill it.
+  (let ((answer 'recenter))
+    (if (and (display-popup-menus-p)
+             (listp last-nonmenu-event)
+             use-dialog-box)
+        (setq answer
+              (x-popup-dialog t `(,prompt ("yes" . act) ("No" . skip))))
+      (setq prompt (concat prompt
+                           (if (eq ?\s (aref prompt (1- (length prompt))))
+                               "" " ")
+                           "(y or n) "))
+      (while
+          (let* ((key
+                  (let ((cursor-in-echo-area t))
+                    (when minibuffer-auto-raise
+                      (raise-frame (window-frame (minibuffer-window))))
+                    (read-key (propertize (if (eq answer 'recenter)
+                                              prompt
+                                            (concat "Please answer y or n.  "
+                                                    prompt))
+                                          'face 'minibuffer-prompt)))))
+            (setq answer (lookup-key query-replace-map (vector key) t))
+            (cond
+             ((memq answer '(skip act)) nil)
+             ((eq answer 'recenter) (recenter) t)
+             ((memq answer '(exit-prefix quit)) (signal 'quit nil) t)
+             (t t)))
+        (ding)
+        (discard-input)))
+    (let ((ret (eq answer 'act)))
+      (unless noninteractive
+        (message "%s %s" prompt (if ret "y" "n")))
+      ret)))
+
 ;;;; Mail user agents.
 
 ;; Here we include just enough for other packages to be able
@@ -3408,51 +3474,59 @@ The properties used on SYMBOL are `composefunc', `sendfunc',
 ;; digits of precision, it doesn't really matter here.  On the other
 ;; hand, it greatly simplifies the code.
 
-(defsubst progress-reporter-update (reporter value)
+(defsubst progress-reporter-update (reporter &optional value)
   "Report progress of an operation in the echo area.
-However, if the change since last echo area update is too small
-or not enough time has passed, then do nothing (see
-`make-progress-reporter' for details).
-
-First parameter, REPORTER, should be the result of a call to
-`make-progress-reporter'.  Second, VALUE, determines the actual
-progress of operation; it must be between MIN-VALUE and MAX-VALUE
-as passed to `make-progress-reporter'.
-
-This function is very inexpensive, you may not bother how often
-you call it."
-  (when (>= value (car reporter))
-    (progress-reporter-do-update reporter value)))
+REPORTER should be the result of a call to `make-progress-reporter'.
+
+If REPORTER is a numerical progress reporter---i.e. if it was
+ made using non-nil MIN-VALUE and MAX-VALUE arguments to
+ `make-progress-reporter'---then VALUE should be a number between
+ MIN-VALUE and MAX-VALUE.
 
-(defun make-progress-reporter (message min-value max-value
-                                      &optional current-value
-                                      min-change min-time)
-  "Return progress reporter object to be used with `progress-reporter-update'.
-
-MESSAGE is shown in the echo area.  When at least 1% of operation
-is complete, the exact percentage will be appended to the
-MESSAGE.  When you call `progress-reporter-done', word \"done\"
-is printed after the MESSAGE.  You can change MESSAGE of an
-existing progress reporter with `progress-reporter-force-update'.
-
-MIN-VALUE and MAX-VALUE designate starting (0% complete) and
-final (100% complete) states of operation.  The latter should be
-larger; if this is not the case, then simply negate all values.
-Optional CURRENT-VALUE specifies the progress by the moment you
-call this function.  You should omit it or set it to nil in most
-cases since it defaults to MIN-VALUE.
-
-Optional MIN-CHANGE determines the minimal change in percents to
-report (default is 1%.)  Optional MIN-TIME specifies the minimal
-time before echo area updates (default is 0.2 seconds.)  If
-`float-time' function is not present, then time is not tracked
-at all.  If OS is not capable of measuring fractions of seconds,
-then this parameter is effectively rounded up."
+If REPORTER is a non-numerical reporter, VALUE should be nil.
 
+This function is relatively inexpensive.  If the change since
+last update is too small or insufficient time has passed, it does
+nothing."
+  (when (or (not (numberp value))      ; For pulsing reporter
+           (>= value (car reporter))) ; For numerical reporter
+    (progress-reporter-do-update reporter value)))
+
+(defun make-progress-reporter (message &optional min-value max-value
+                                      current-value min-change min-time)
+  "Return progress reporter object for use with `progress-reporter-update'.
+
+MESSAGE is shown in the echo area, with a status indicator
+appended to the end.  When you call `progress-reporter-done', the
+word \"done\" is printed after the MESSAGE.  You can change the
+MESSAGE of an existing progress reporter by calling
+`progress-reporter-force-update'.
+
+MIN-VALUE and MAX-VALUE, if non-nil, are starting (0% complete)
+and final (100% complete) states of operation; the latter should
+be larger.  In this case, the status message shows the percentage
+progress.
+
+If MIN-VALUE and/or MAX-VALUE is omitted or nil, the status
+message shows a \"spinning\", non-numeric indicator.
+
+Optional CURRENT-VALUE is the initial progress; the default is
+MIN-VALUE.
+Optional MIN-CHANGE is the minimal change in percents to report;
+the default is 1%.
+CURRENT-VALUE and MIN-CHANGE do not have any effect if MIN-VALUE
+and/or MAX-VALUE are nil.
+
+Optional MIN-TIME specifies the minimum interval time between
+echo area updates (default is 0.2 seconds.)  If the function
+`float-time' is not present, time is not tracked at all.  If the
+OS is not capable of measuring fractions of seconds, this
+parameter is effectively rounded up."
   (unless min-time
     (setq min-time 0.2))
   (let ((reporter
-        (cons min-value ;; Force a call to `message' now
+        ;; Force a call to `message' now
+        (cons (or min-value 0)
               (vector (if (and (fboundp 'float-time)
                                (>= min-time 0.02))
                           (float-time) nil)
@@ -3464,12 +3538,11 @@ then this parameter is effectively rounded up."
     (progress-reporter-update reporter (or current-value min-value))
     reporter))
 
-(defun progress-reporter-force-update (reporter value &optional new-message)
+(defun progress-reporter-force-update (reporter &optional value new-message)
   "Report progress of an operation in the echo area unconditionally.
 
-First two parameters are the same as for
-`progress-reporter-update'.  Optional NEW-MESSAGE allows you to
-change the displayed message."
+The first two arguments are the same as in `progress-reporter-update'.
+NEW-MESSAGE, if non-nil, sets a new message for the reporter."
   (let ((parameters (cdr reporter)))
     (when new-message
       (aset parameters 3 new-message))
@@ -3477,15 +3550,15 @@ change the displayed message."
       (aset parameters 0 (float-time)))
     (progress-reporter-do-update reporter value)))
 
+(defvar progress-reporter--pulse-characters ["-" "\\" "|" "/"]
+  "Characters to use for pulsing progress reporters.")
+
 (defun progress-reporter-do-update (reporter value)
   (let* ((parameters   (cdr reporter))
+        (update-time  (aref parameters 0))
         (min-value    (aref parameters 1))
         (max-value    (aref parameters 2))
-        (one-percent  (/ (- max-value min-value) 100.0))
-        (percentage   (if (= max-value min-value)
-                          0
-                        (truncate (/ (- value min-value) one-percent))))
-        (update-time  (aref parameters 0))
+        (text         (aref parameters 3))
         (current-time (float-time))
         (enough-time-passed
          ;; See if enough time has passed since the last update.
@@ -3493,26 +3566,41 @@ change the displayed message."
              (when (>= current-time update-time)
                ;; Calculate time for the next update
                (aset parameters 0 (+ update-time (aref parameters 5)))))))
-    ;;
-    ;; Calculate NEXT-UPDATE-VALUE.  If we are not going to print
-    ;; message this time because not enough time has passed, then use
-    ;; 1 instead of MIN-CHANGE.  This makes delays between echo area
-    ;; updates closer to MIN-TIME.
-    (setcar reporter
-           (min (+ min-value (* (+ percentage
-                                   (if enough-time-passed
-                                       (aref parameters 4) ;; MIN-CHANGE
-                                     1))
-                                one-percent))
-                max-value))
-    (when (integerp value)
-      (setcar reporter (ceiling (car reporter))))
-    ;;
-    ;; Only print message if enough time has passed
-    (when enough-time-passed
-      (if (> percentage 0)
-         (message "%s%d%%" (aref parameters 3) percentage)
-       (message "%s" (aref parameters 3))))))
+    (cond ((and min-value max-value)
+          ;; Numerical indicator
+          (let* ((one-percent (/ (- max-value min-value) 100.0))
+                 (percentage  (if (= max-value min-value)
+                                  0
+                                (truncate (/ (- value min-value)
+                                             one-percent)))))
+            ;; Calculate NEXT-UPDATE-VALUE.  If we are not printing
+            ;; message because not enough time has passed, use 1
+            ;; instead of MIN-CHANGE.  This makes delays between echo
+            ;; area updates closer to MIN-TIME.
+            (setcar reporter
+                    (min (+ min-value (* (+ percentage
+                                            (if enough-time-passed
+                                                ;; MIN-CHANGE
+                                                (aref parameters 4)
+                                              1))
+                                         one-percent))
+                         max-value))
+            (when (integerp value)
+              (setcar reporter (ceiling (car reporter))))
+            ;; Only print message if enough time has passed
+            (when enough-time-passed
+              (if (> percentage 0)
+                  (message "%s%d%%" text percentage)
+                (message "%s" text)))))
+         ;; Pulsing indicator
+         (enough-time-passed
+          (let ((index (mod (1+ (car reporter)) 4))
+                (message-log-max nil))
+            (setcar reporter index)
+            (message "%s %s"
+                     text
+                     (aref progress-reporter--pulse-characters
+                           index)))))))
 
 (defun progress-reporter-done (reporter)
   "Print reporter's message followed by word \"done\" in echo area."
@@ -3555,11 +3643,11 @@ Usually the separator is \".\", but it can be any other string.")
 
 
 (defconst version-regexp-alist
-  '(("^[-_+ ]?a\\(lpha\\)?$"   . -3)
+  '(("^[-_+ ]?alpha$"   . -3)
     ("^[-_+]$"                 . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases
     ("^[-_+ ]cvs$"             . -3)   ; treat "1.2.3-CVS" as alpha release
-    ("^[-_+ ]?b\\(eta\\)?$"    . -2)
-    ("^[-_+ ]?\\(pre\\|rc\\)$" . -1))
+    ("^[-_+ ]?beta$"    . -2)
+    ("^[-_+ ]?\\(pre\\|rcc\\)$" . -1))
   "*Specify association between non-numeric version and its priority.
 
 This association is used to handle version string like \"1.0pre2\",
@@ -3652,8 +3740,13 @@ See documentation for `version-separator' and `version-regexp-alist'."
            (setq al version-regexp-alist)
            (while (and al (not (string-match (caar al) s)))
              (setq al (cdr al)))
-           (or al (error "Invalid version syntax: '%s'" ver))
-           (setq lst (cons (cdar al) lst)))))
+           (cond (al
+                  (push (cdar al) lst))
+                 ;; Convert 22.3a to 22.3.1.
+                 ((string-match "^[-_+ ]?\\([a-zA-Z]\\)$" s)
+                  (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)))))