;;; subr.el --- basic lisp subroutines for Emacs
;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005 Free Software Foundation, Inc.
+;; 2004, 2005, 2006 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
(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)
Alternatively, if optional fourth argument OLDMAP is specified, we redefine
in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP.
-For most uses, it is simpler and safer to use command remappping like this:
- \(define-key KEYMAP [remap OLDDEF] NEWDEF)"
+If you don't specify OLDMAP, you can usually get the same results
+in a cleaner way with command remapping, like this:
+ \(define-key KEYMAP [remap OLDDEF] NEWDEF)
+\n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)"
;; Don't document PREFIX in the doc string because we don't want to
;; advertise it. It's meant for recursive calls only. Here's its
;; meaning
(nconc (nreverse skipped) newdef)))
;; Look past a symbol that names a keymap.
(setq inner-def
- (and defn
- (condition-case nil (indirect-function defn) (error defn))))
+ (or (indirect-function defn t) defn))
;; For nested keymaps, we use `inner-def' rather than `defn' so as to
;; avoid autoloading a keymap. This is mostly done to preserve the
;; original non-autoloading behavior of pre-map-keymap times.
(nth 3 position))
(defsubst posn-string (position)
- "Return the string object of POSITION, or nil if a buffer position.
+ "Return the string object of POSITION.
+Value is a cons (STRING . STRING-POS), or nil if not a string.
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.
+ "Return the image object of POSITION.
+Value is an list (image ...), or nil if 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.
+Value is a list (image ...) for an image object, a cons cell
+\(STRING . STRING-POS) for a string object, and nil for a buffer 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)))
(if (and oa ob)
(< oa ob)
oa)))))))
+
+(defun add-to-history (history-var newelt &optional maxelt keep-dups)
+ "Add NEWELT to the history list stored in the variable HISTORY-VAR.
+Return the new history list.
+If MAXELT is non-nil, it specifies the maximum length of the history.
+Otherwise, the maximum history length is the value of the `history-length'
+property on symbol HISTORY-VAR, if set, or the value of the `history-length'
+variable.
+Remove duplicates of NEWELT unless `history-delete-duplicates' is nil
+or KEEP-DUPS is non-nil."
+ (unless maxelt
+ (setq maxelt (or (get history-var 'history-length)
+ history-length)))
+ (let ((history (symbol-value history-var))
+ tail)
+ (if (and history-delete-duplicates (not keep-dups))
+ (setq history (delete newelt history)))
+ (setq history (cons newelt history))
+ (when (integerp maxelt)
+ (if (= 0 maxelt)
+ (setq history nil)
+ (setq tail (nthcdr (1- maxelt) history))
+ (when (consp tail)
+ (setcdr tail nil))))
+ (set history-var history)))
+
\f
;;;; Mode hooks.
\f
;;; Load history
-;;; (defvar symbol-file-load-history-loaded nil
-;;; "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'.
-;;; That file records the part of `load-history' for preloaded files,
-;;; which is cleared out before dumping to make Emacs smaller.")
-
-;;; (defun load-symbol-file-load-history ()
-;;; "Load the file `fns-VERSION.el' in `exec-directory' if not already done.
-;;; That file records the part of `load-history' for preloaded files,
-;;; which is cleared out before dumping to make Emacs smaller."
-;;; (unless symbol-file-load-history-loaded
-;;; (load (expand-file-name
-;;; ;; fns-XX.YY.ZZ.el does not work on DOS filesystem.
-;;; (if (eq system-type 'ms-dos)
-;;; "fns.el"
-;;; (format "fns-%s.el" emacs-version))
-;;; exec-directory)
-;;; ;; The file name fns-%s.el already has a .el extension.
-;;; nil nil t)
-;;; (setq symbol-file-load-history-loaded t)))
+;; (defvar symbol-file-load-history-loaded nil
+;; "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'.
+;; That file records the part of `load-history' for preloaded files,
+;; which is cleared out before dumping to make Emacs smaller.")
+
+;; (defun load-symbol-file-load-history ()
+;; "Load the file `fns-VERSION.el' in `exec-directory' if not already done.
+;; That file records the part of `load-history' for preloaded files,
+;; which is cleared out before dumping to make Emacs smaller."
+;; (unless symbol-file-load-history-loaded
+;; (load (expand-file-name
+;; ;; fns-XX.YY.ZZ.el does not work on DOS filesystem.
+;; (if (eq system-type 'ms-dos)
+;; "fns.el"
+;; (format "fns-%s.el" emacs-version))
+;; exec-directory)
+;; ;; The file name fns-%s.el already has a .el extension.
+;; nil nil t)
+;; (setq symbol-file-load-history-loaded t)))
(defun symbol-file (symbol &optional type)
"Return the input source in which SYMBOL was defined.
and the file name is displayed in the echo area."
(interactive (list (completing-read "Locate library: "
'locate-file-completion
- (cons load-path load-suffixes))
+ (cons load-path (get-load-suffixes)))
nil nil
t))
(let ((file (locate-file library
(or path load-path)
- (append (unless nosuffix load-suffixes) '("")))))
+ (append (unless nosuffix (get-load-suffixes))
+ load-file-rep-suffixes))))
(if interactive-call
(if file
(message "Library is file %s" (abbreviate-file-name file))
(let ((pass nil)
(c 0)
(echo-keystrokes 0)
- (cursor-in-echo-area t))
+ (cursor-in-echo-area t)
+ (message-log-max nil))
(add-text-properties 0 (length prompt)
minibuffer-prompt-properties prompt)
(while (progn (message "%s%s"
(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)
This variable is meaningful on MS-DOG and Windows NT.
On those systems, it is automatically local in every buffer.
On other systems, this variable is normally always nil.")
+
+;; The `assert' macro from the cl package signals
+;; `cl-assertion-failed' at runtime so always define it.
+(put 'cl-assertion-failed 'error-conditions '(error))
+(put 'cl-assertion-failed 'error-message "Assertion failed")
+
\f
;;;; Misc. useful functions.
"\\" (substring argument end (1+ end)))
start (1+ end)))
(concat result (substring argument start)))))))
+
+(defun string-or-null-p (object)
+ "Return t if OBJECT is a string or nil.
+Otherwise, return nil."
+ (or (stringp object) (null object)))
+
+(defun booleanp (object)
+ "Return non-nil if OBJECT is one of the two canonical boolean values: t or nil."
+ (memq object '(nil t)))
+
\f
;;;; Support for yanking and text properties.
((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)))
+`lazy-completion-table' must be used to initialize the value of VAR.
+
+You should give VAR a non-nil `risky-local-variable' property."
+ (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)
(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\",
\"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:
\"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