that complains if FORM ever does return differing values."
form)
+(defmacro def-edebug-spec (symbol spec)
+ "Set the `edebug-form-spec' property of SYMBOL according to SPEC.
+Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
+\(naming a function), or a list."
+ `(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))
+
(defmacro lambda (&rest cdr)
"Return a lambda expression.
A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is
(declare (indent 1) (debug t))
(cons 'if (cons cond (cons nil body))))
+(defvar --dolist-tail-- nil
+ "Temporary variable used in `dolist' expansion.")
+
(defmacro dolist (spec &rest body)
"Loop over a list.
Evaluate BODY with VAR bound to each car from LIST, in turn.
\(fn (VAR LIST [RESULT]) BODY...)"
(declare (indent 1) (debug ((symbolp form &optional form) body)))
- (let ((temp (make-symbol "--dolist-temp--")))
+ ;; It would be cleaner to create an uninterned symbol,
+ ;; but that uses a lot more space when many functions in many files
+ ;; use dolist.
+ (let ((temp '--dolist-tail--))
`(let ((,temp ,(nth 1 spec))
,(car spec))
(while ,temp
(setq ,(car spec) (car ,temp))
- (setq ,temp (cdr ,temp))
- ,@body)
+ ,@body
+ (setq ,temp (cdr ,temp)))
,@(if (cdr (cdr spec))
`((setq ,(car spec) nil) ,@(cdr (cdr spec)))))))
+(defvar --dotimes-limit-- nil
+ "Temporary variable used in `dotimes' expansion.")
+
(defmacro dotimes (spec &rest body)
"Loop a certain number of times.
Evaluate BODY with VAR bound to successive integers running from 0,
\(fn (VAR COUNT [RESULT]) BODY...)"
(declare (indent 1) (debug dolist))
- (let ((temp (make-symbol "--dotimes-temp--"))
+ ;; It would be cleaner to create an uninterned symbol,
+ ;; but that uses a lot more space when many functions in many files
+ ;; use dotimes.
+ (let ((temp '--dotimes-limit--)
(start 0)
(end (nth 1 spec)))
`(let ((,temp ,end)
(kill-local-variable hook)
(set hook hook-value))))))
-(defun add-to-list (list-var element &optional append)
+(defun add-to-list (list-var element &optional append compare-fn)
"Add ELEMENT to the value of LIST-VAR if it isn't there yet.
-The test for presence of ELEMENT is done with `equal'.
+The test for presence of ELEMENT is done with `equal',
+or with COMPARE-FN if that's non-nil.
If ELEMENT is added, it is added at the beginning of the list,
unless the optional argument APPEND is non-nil, in which case
ELEMENT is added at the end.
into a hook function that will be run only after loading the package.
`eval-after-load' provides one way to do this. In some cases
other hooks, such as major mode hooks, can do the job."
- (if (member element (symbol-value list-var))
+ (if (if compare-fn
+ (let (present)
+ (dolist (elt (symbol-value list-var))
+ (if (funcall compare-fn element elt)
+ (setq present t)))
+ present)
+ (member element (symbol-value list-var)))
(symbol-value list-var)
(set list-var
(if append
(< oa ob)
oa)))))))
-(defun add-to-history (history-var newelt &optional maxelt)
+(defun add-to-history (history-var newelt &optional maxelt keep-all)
"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."
+Remove duplicates of NEWELT if `history-delete-duplicates' is non-nil.
+If optional fourth arg KEEP-ALL is non-nil, add NEWELT to history even
+if it is empty or a duplicate."
(unless maxelt
(setq maxelt (or (get history-var 'history-length)
history-length)))
(let ((history (symbol-value history-var))
tail)
- (if history-delete-duplicates
- (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))))
+ (when (and (listp history)
+ (or keep-all
+ (not (stringp newelt))
+ (> (length newelt) 0))
+ (or keep-all
+ (not (equal (car history) newelt))))
+ (if history-delete-duplicates
+ (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
t))
nil))
+(defun load-history-regexp (file)
+ "Form a regexp to find FILE in `load-history'.
+FILE, a string, is described in the function `eval-after-load'."
+ (if (file-name-absolute-p file)
+ (setq file (file-truename file)))
+ (concat (if (file-name-absolute-p file) "\\`" "\\(\\`\\|/\\)")
+ (regexp-quote file)
+ (if (file-name-extension file)
+ ""
+ ;; Note: regexp-opt can't be used here, since we need to call
+ ;; this before Emacs has been fully started. 2006-05-21
+ (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?"))
+ "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|")
+ "\\)?\\'"))
+
+(defun load-history-filename-element (file-regexp)
+ "Get the first elt of `load-history' whose car matches FILE-REGEXP.
+Return nil if there isn't one."
+ (let* ((loads load-history)
+ (load-elt (and loads (car loads))))
+ (save-match-data
+ (while (and loads
+ (or (null (car load-elt))
+ (not (string-match file-regexp (car load-elt)))))
+ (setq loads (cdr loads)
+ load-elt (and loads (car loads)))))
+ load-elt))
+
(defun eval-after-load (file form)
"Arrange that, if FILE is ever loaded, FORM will be run at that time.
-This makes or adds to an entry on `after-load-alist'.
If FILE is already loaded, evaluate FORM right now.
-It does nothing if FORM is already on the list for FILE.
-FILE must match exactly. Normally FILE is the name of a library,
-with no directory or extension specified, since that is how `load'
-is normally called.
-FILE can also be a feature (i.e. a symbol), in which case FORM is
-evaluated whenever that feature is `provide'd."
- (let ((elt (assoc file after-load-alist)))
- ;; Make sure there is an element for FILE.
- (unless elt (setq elt (list file)) (push elt after-load-alist))
- ;; Add FORM to the element if it isn't there.
+
+If a matching file is loaded again, FORM will be evaluated again.
+
+If FILE is a string, it may be either an absolute or a relative file
+name, and may have an extension \(e.g. \".el\") or may lack one, and
+additionally may or may not have an extension denoting a compressed
+format \(e.g. \".gz\").
+
+When FILE is absolute, this first converts it to a true name by chasing
+symbolic links. Only a file of this name \(see next paragraph regarding
+extensions) will trigger the evaluation of FORM. When FILE is relative,
+a file whose absolute true name ends in FILE will trigger evaluation.
+
+When FILE lacks an extension, a file name with any extension will trigger
+evaluation. Otherwise, its extension must match FILE's. A further
+extension for a compressed format \(e.g. \".gz\") on FILE will not affect
+this name matching.
+
+Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM
+is evaluated whenever that feature is `provide'd.
+
+Usually FILE is just a library name like \"font-lock\" or a feature name
+like 'font-lock.
+
+This function makes or adds to an entry on `after-load-alist'."
+ ;; Add this FORM into after-load-alist (regardless of whether we'll be
+ ;; evaluating it now).
+ (let* ((regexp-or-feature
+ (if (stringp file) (load-history-regexp file) file))
+ (elt (assoc regexp-or-feature after-load-alist)))
+ (unless elt
+ (setq elt (list regexp-or-feature))
+ (push elt after-load-alist))
+ ;; Add FORM to the element unless it's already there.
(unless (member form (cdr elt))
- (nconc elt (list form))
- ;; If the file has been loaded already, run FORM right away.
- (if (if (symbolp file)
- (featurep file)
- ;; Make sure `load-history' contains the files dumped with
- ;; Emacs for the case that FILE is one of them.
- ;; (load-symbol-file-load-history)
- (when (locate-library file)
- (assoc (locate-library file) load-history)))
- (eval form))))
- form)
+ (nconc elt (list form)))
+
+ ;; Is there an already loaded file whose name (or `provide' name)
+ ;; matches FILE?
+ (if (if (stringp file)
+ (load-history-filename-element regexp-or-feature)
+ (featurep file))
+ (eval form))))
+
+(defun do-after-load-evaluation (abs-file)
+ "Evaluate all `eval-after-load' forms, if any, for ABS-FILE.
+ABS-FILE, a string, should be the absolute true name of a file just loaded."
+ (let ((after-load-elts after-load-alist)
+ a-l-element file-elements file-element form)
+ (while after-load-elts
+ (setq a-l-element (car after-load-elts)
+ after-load-elts (cdr after-load-elts))
+ (when (and (stringp (car a-l-element))
+ (string-match (car a-l-element) abs-file))
+ (while (setq a-l-element (cdr a-l-element)) ; discard the file name
+ (setq form (car a-l-element))
+ (eval form))))))
(defun eval-next-after-load (file)
"Read the following input sexp, and run it whenever FILE is loaded.
This function echoes `.' for each character that the user types.
The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line.
C-g quits; if `inhibit-quit' was non-nil around this function,
-then it returns nil if the user types C-g.
+then it returns nil if the user types C-g, but quit-flag remains set.
Once the caller uses the password, it can erase the password
by doing (clear-string STRING)."
(sit-for 1))))
success)
(let ((pass nil)
+ ;; Copy it so that add-text-properties won't modify
+ ;; the object that was passed in by the caller.
+ (prompt (copy-sequence prompt))
(c 0)
(echo-keystrokes 0)
(cursor-in-echo-area t)
(sit-for 1)
t)))
n))
+
+(defun sit-for (seconds &optional nodisp obsolete)
+ "Perform redisplay, then wait for SECONDS seconds or until 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.)
+
+If optional arg NODISP is t, don't redisplay, just wait for input.
+Redisplay does not happen if input is available before it starts.
+
+Value is t if waited the full time with no input arriving, and nil otherwise.
+
+An obsolete, but still supported form is
+\(sit-for SECONDS &optional MILLISECONDS NODISP)
+where the optional arg MILLISECONDS specifies an additional wait period,
+in milliseconds; this was useful when Emacs was built without
+floating point support.
+
+\(fn SECONDS &optional NODISP)"
+ (when (or obsolete (numberp nodisp))
+ (setq seconds (+ seconds (* 1e-3 nodisp)))
+ (setq nodisp obsolete))
+ (cond
+ (noninteractive
+ (sleep-for seconds)
+ t)
+ ((input-pending-p)
+ nil)
+ ((<= seconds 0)
+ (or nodisp (redisplay)))
+ (t
+ (or nodisp (redisplay))
+ (let ((read (read-event nil nil seconds)))
+ (or (null read)
+ (progn (push read unread-command-events)
+ nil))))))
\f
;;; Atomic change groups.
"Return non-nil if OBJECT is one of the two canonical boolean values: t or nil."
(memq object '(nil t)))
-(defun field-at-point (pos)
+(defun field-at-pos (pos)
"Return the field at position POS, taking stickiness etc into account"
(let ((raw-field (get-char-property (field-beginning pos) 'field)))
(if (eq raw-field 'boundary)
;;;; Lisp macros to do various things temporarily.
(defmacro with-current-buffer (buffer &rest body)
- "Execute the forms in BODY with BUFFER as the current buffer.
+ "Execute the forms in BODY with BUFFER temporarily current.
+BUFFER can be a buffer or a buffer name.
The value returned is the value of the last form in BODY.
See also `with-temp-buffer'."
(declare (indent 1) (debug t))
(defmacro with-local-quit (&rest body)
"Execute BODY, allowing quits to terminate BODY but not escape further.
When a quit terminates BODY, `with-local-quit' returns nil but
-requests another quit. That quit will be processed, the next time quitting
-is allowed once again."
+requests another quit. That quit will be processed as soon as quitting
+is allowed once again. (Immediately, if `inhibit-quit' is nil.)"
(declare (debug t) (indent 0))
`(condition-case nil
(let ((inhibit-quit nil))
,@body)
- (quit (setq quit-flag t) nil)))
+ (quit (setq quit-flag t)
+ ;; This call is to give a chance to handle quit-flag
+ ;; in case inhibit-quit is nil.
+ ;; Without this, it will not be handled until the next function
+ ;; call, and that might allow it to exit thru a condition-case
+ ;; that intends to handle the quit signal next time.
+ (eval '(ignore nil)))))
(defmacro while-no-input (&rest body)
"Execute BODY only as long as there's no pending input.
`(with-local-quit
(catch ',catch-sym
(let ((throw-on-input ',catch-sym))
- (or (not (sit-for 0 0 t))
- ,@body))))))
+ (or (input-pending-p)
+ ,@body))))))
(defmacro combine-after-change-calls (&rest body)
"Execute BODY, but don't call the after-change functions till the end.
(defun looking-back (regexp &optional limit greedy)
"Return non-nil if text before point matches regular expression REGEXP.
Like `looking-at' except matches before point, and is slower.
-LIMIT if non-nil speeds up the search by specifying how far back the
-match can start.
+LIMIT if non-nil speeds up the search by specifying a minimum
+starting position, to avoid checking matches that would start
+before LIMIT.
If GREEDY is non-nil, extend the match backwards as far as possible,
stopping when a single additional previous character cannot be part