* spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p)
[bpt/emacs.git] / lisp / subr.el
index 2348c1e..ac917a1 100644 (file)
@@ -42,17 +42,15 @@ Each element of this list holds the arguments to one call to `defcustom'.")
 (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
-signaled."
+  "Evaluate FORM, expecting it not to return.
+If FORM does return, signal an error."
   `(prog1 ,form
      (error "Form marked with `noreturn' did return")))
 
 (defmacro 1value (form)
-  "Evaluates FORM, with the expectation that 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."
+  "Evaluate FORM, expecting a constant return value.
+This is the global do-nothing version.  There is also `testcover-1value'
+that complains if FORM ever does return differing values."
   form)
 
 (defmacro lambda (&rest cdr)
@@ -183,18 +181,6 @@ macros."
           (not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object)))))))
       (subrp object) (byte-code-function-p object)
       (eq (car-safe object) 'lambda)))
-
-;; This should probably be written in C (i.e., without using `walk-windows').
-(defun get-buffer-window-list (buffer &optional minibuf frame)
-  "Return list of all windows displaying BUFFER, or nil if none.
-BUFFER can be a buffer or a buffer name.
-See `walk-windows' for the meaning of MINIBUF and FRAME."
-  (let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows)
-    (walk-windows (function (lambda (window)
-                             (if (eq (window-buffer window) buffer)
-                                 (setq windows (cons window windows)))))
-                 minibuf frame)
-    windows))
 \f
 ;;;; List functions.
 
@@ -1321,8 +1307,52 @@ definition only or variable definition only.
        (setq files (cdr files)))
       file)))
 
+;;;###autoload
+(defun locate-library (library &optional nosuffix path interactive-call)
+  "Show the precise file name of Emacs library LIBRARY.
+This command searches the directories in `load-path' like `\\[load-library]'
+to find the file that `\\[load-library] RET LIBRARY RET' would load.
+Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes'
+to the specified name LIBRARY.
+
+If the optional third arg PATH is specified, that list of directories
+is used instead of `load-path'.
+
+When called from a program, the file name is normaly returned as a
+string.  When run interactively, the argument INTERACTIVE-CALL is t,
+and the file name is displayed in the echo area."
+  (interactive (list (completing-read "Locate library: "
+                                     'locate-file-completion
+                                     (cons load-path load-suffixes))
+                    nil nil
+                    t))
+  (let ((file (locate-file library
+                          (or path load-path)
+                          (append (unless nosuffix load-suffixes) '("")))))
+    (if interactive-call
+       (if file
+           (message "Library is file %s" (abbreviate-file-name file))
+         (message "No library %s in search path" library)))
+    file))
+
 \f
-;;;; Specifying things to do after certain files are loaded.
+;;;; Specifying things to do later.
+
+(defmacro eval-at-startup (&rest body)
+  "Make arrangements to evaluate BODY when Emacs starts up.
+If this is run after Emacs startup, evaluate BODY immediately.
+Always returns nil.
+
+This works by adding a function to `before-init-hook'.
+That function's doc string says which file created it."
+  `(progn
+     (if command-line-processed
+        (progn . ,body)
+       (add-hook 'before-init-hook
+                '(lambda () ,(concat "From " (or load-file-name "no file"))
+                   . ,body)
+                t))
+     nil))
 
 (defun eval-after-load (file form)
   "Arrange that, if FILE is ever loaded, FORM will be run at that time.
@@ -1346,7 +1376,8 @@ evaluated whenever that feature is `provide'd."
            ;; Make sure `load-history' contains the files dumped with
            ;; Emacs for the case that FILE is one of them.
            ;; (load-symbol-file-load-history)
-           (assoc file load-history))
+           (when (locate-library file)
+             (assoc (locate-library file) load-history)))
          (eval form))))
   form)
 
@@ -1508,6 +1539,8 @@ by doing (clear-string STRING)."
            (c 0)
            (echo-keystrokes 0)
            (cursor-in-echo-area t))
+       (add-text-properties 0 (length prompt)
+                            minibuffer-prompt-properties prompt)
        (while (progn (message "%s%s"
                               prompt
                               (make-string (length pass) ?.))
@@ -1567,6 +1600,7 @@ This works regardless of whether undo is enabled in the buffer.
 This mechanism is transparent to ordinary use of undo;
 if undo is enabled in the buffer and BODY succeeds, the
 user can undo the change normally."
+  (declare (indent 0) (debug t))
   (let ((handle (make-symbol "--change-group-handle--"))
        (success (make-symbol "--change-group-success--")))
     `(let ((,handle (prepare-change-group))
@@ -1650,7 +1684,7 @@ This finishes the change group by reverting all of its changes."
        (when (and (consp elt) (not (eq elt (last pending-undo-list))))
          (error "Undoing to some unrelated state"))
        ;; Undo it all.
-       (while pending-undo-list (undo-more 1))
+       (while (listp pending-undo-list) (undo-more 1))
        ;; Reset the modified cons cell ELT to its original content.
        (when (consp elt)
          (setcar elt old-car)
@@ -1845,43 +1879,6 @@ a system-dependent default device name is used."
       (play-sound-internal sound)
     (error "This Emacs binary lacks sound support")))
 
-(defun make-temp-file (prefix &optional dir-flag suffix)
-  "Create a temporary file.
-The returned file name (created by appending some random characters at the end
-of PREFIX, and expanding against `temporary-file-directory' if necessary),
-is guaranteed to point to a newly created empty file.
-You can then use `write-region' to write new data into the file.
-
-If DIR-FLAG is non-nil, create a new empty directory instead of a file.
-
-If SUFFIX is non-nil, add that at the end of the file name."
-  (let ((umask (default-file-modes))
-       file)
-    (unwind-protect
-       (progn
-         ;; Create temp files with strict access rights.  It's easy to
-         ;; loosen them later, whereas it's impossible to close the
-         ;; time-window of loose permissions otherwise.
-         (set-default-file-modes ?\700)
-         (while (condition-case ()
-                    (progn
-                      (setq file
-                            (make-temp-name
-                             (expand-file-name prefix temporary-file-directory)))
-                      (if suffix
-                          (setq file (concat file suffix)))
-                      (if dir-flag
-                          (make-directory file)
-                        (write-region "" nil file nil 'silent nil 'excl))
-                      nil)
-                  (file-already-exists t))
-           ;; the file was somehow created by someone else between
-           ;; `make-temp-name' and `write-region', let's try again.
-           nil)
-         file)
-      ;; Reset the umask.
-      (set-default-file-modes umask))))
-
 (defun shell-quote-argument (argument)
   "Quote an argument for passing as argument to an inferior shell."
   (if (eq system-type 'ms-dos)
@@ -2257,20 +2254,33 @@ that can be used as the ALIST argument to `try-completion' and
           ((not ,mode) (try-completion ,string (,fun ,string) ,predicate))
           (t (test-completion ,string (,fun ,string) ,predicate)))))))
 
-(defmacro lazy-completion-table (var fun &rest args)
+(defmacro lazy-completion-table (var fun)
+  ;; We used to have `&rest args' where `args' were evaluated late (at the
+  ;; time of the call to `fun'), which was counter intuitive.  But to get
+  ;; them to be evaluated early, we have to either use lexical-let (which is
+  ;; not available in subr.el) or use `(lambda (,str) ...) which prevents the use
+  ;; of lexical-let in the callers.
+  ;; So we just removed the argument.  Callers can then simply use either of:
+  ;;   (lazy-completion-table var (lambda () (fun x y)))
+  ;; or
+  ;;   (lazy-completion-table var `(lambda () (fun ',x ',y)))
+  ;; or
+  ;;   (lexical-let ((x x)) ((y y))
+  ;;     (lazy-completion-table var (lambda () (fun x y))))
+  ;; depending on the behavior they want.
   "Initialize variable VAR as a lazy completion table.
 If the completion table VAR is used for the first time (e.g., by passing VAR
-as an argument to `try-completion'), the function FUN is called with arguments
-ARGS.  FUN must return the completion table that will be stored in VAR.
+as an argument to `try-completion'), the function FUN is called with no
+arguments.  FUN must return the completion table that will be stored in VAR.
 If completion is requested in the minibuffer, FUN will be called in the buffer
 from which the minibuffer was entered.  The return value of
 `lazy-completion-table' must be used to initialize the value of VAR."
-  (declare (debug (symbol lambda-expr def-body)))
+  (declare (debug (symbol lambda-expr)))
   (let ((str (make-symbol "string")))
     `(dynamic-completion-table
       (lambda (,str)
-        (unless (listp ,var)
-          (setq ,var (,fun ,@args)))
+        (when (functionp ,var)
+          (setq ,var (,fun)))
         ,var))))
 
 (defmacro complete-in-turn (a b)
@@ -2896,11 +2906,11 @@ Usually the separator is \".\", but it can be any other string.")
 
 
 (defvar version-regexp-alist
-  '(("^[-_+]?a\\(lpha\\)?$"   . -3)
+  '(("^[-_+ ]?a\\(lpha\\)?$"   . -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))
+    ("^[-_+ ]cvs$" . -3)       ; treat "1.2.3-CVS" as alpha release
+    ("^[-_+ ]?b\\(eta\\)?$"    . -2)
+    ("^[-_+ ]?\\(pre\\|rc\\)$" . -1))
   "*Specify association between non-numeric version part and a priority.
 
 This association is used to handle version string like \"1.0pre2\",
@@ -2911,10 +2921,10 @@ non-numeric part to an integer.  For example:
    \"1.0pre2\"         (1  0 -1 2)
    \"1.0PRE2\"         (1  0 -1 2)
    \"22.8beta3\"       (22 8 -2 3)
-   \"22.8Beta3\"       (22 8 -2 3)
+   \"22.8 Beta3\"      (22 8 -2 3)
    \"0.9alpha1\"       (0  9 -3 1)
    \"0.9AlphA1\"       (0  9 -3 1)
-   \"0.9alpha\"        (0  9 -3)
+   \"0.9 alpha\"       (0  9 -3)
 
 Each element has the following form:
 
@@ -2966,8 +2976,13 @@ As an example of version convertion:
    \"0.9alpha\"        (0  9 -3)
 
 See documentation for `version-separator' and `version-regexp-alist'."
-  (or (and (stringp ver) (not (string= ver "")))
+  (or (and (stringp ver) (> (length ver) 0))
       (error "Invalid version string: '%s'" 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)))
   (save-match-data
     (let ((i 0)
          (case-fold-search t)          ; ignore case in matching