;;; 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 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)
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)))
(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
(if (and oa ob)
(< oa ob)
oa)))))))
+
+(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 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)
+ (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
;;;; 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))
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))
+ (cursor-in-echo-area t)
+ (message-log-max nil))
(add-text-properties 0 (length prompt)
minibuffer-prompt-properties prompt)
(while (progn (message "%s%s"
(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.
(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.
(defun shell-quote-argument (argument)
"Quote an argument for passing as argument to an inferior shell."
- (if (eq system-type 'ms-dos)
+ (if (or (eq system-type 'ms-dos)
+ (and (eq system-type 'windows-nt) (w32-shell-dos-semantics)))
;; Quote using double quotes, but escape any existing quotes in
;; the argument with backslashes.
(let ((result "")
"\\" (substring argument end (1+ end)))
start (1+ end))))
(concat "\"" result (substring argument start) "\""))
- (if (eq system-type 'windows-nt)
- (concat "\"" argument "\"")
- (if (equal argument "")
- "''"
- ;; Quote everything except POSIX filename characters.
- ;; This should be safe enough even for really weird shells.
- (let ((result "") (start 0) end)
- (while (string-match "[^-0-9a-zA-Z_./]" argument start)
- (setq end (match-beginning 0)
- result (concat result (substring argument start end)
- "\\" (substring argument end (1+ end)))
- start (1+ end)))
- (concat result (substring argument start)))))))
+ (if (equal argument "")
+ "''"
+ ;; Quote everything except POSIX filename characters.
+ ;; This should be safe enough even for really weird shells.
+ (let ((result "") (start 0) end)
+ (while (string-match "[^-0-9a-zA-Z_./]" argument start)
+ (setq end (match-beginning 0)
+ result (concat result (substring argument start end)
+ "\\" (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)))
+
+(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)
+ (get-char-property (1- (field-end pos)) 'field)
+ raw-field)))
+
\f
;;;; Support for yanking and text properties.
(let* ((handler (and (stringp string)
(get-text-property 0 'yank-handler string)))
(param (or (nth 1 handler) string))
- (opoint (point)))
+ (opoint (point))
+ end)
+
(setq yank-undo-function t)
(if (nth 0 handler) ;; FUNCTION
(funcall (car handler) param)
(insert param))
+ (setq end (point))
+
+ ;; What should we do with `font-lock-face' properties?
+ (if font-lock-defaults
+ ;; No, just wipe them.
+ (remove-list-of-text-properties opoint end '(font-lock-face))
+ ;; Convert them to `face'.
+ (save-excursion
+ (goto-char opoint)
+ (while (< (point) end)
+ (let ((face (get-text-property (point) 'font-lock-face))
+ run-end)
+ (setq run-end
+ (next-single-property-change (point) 'font-lock-face nil end))
+ (when face
+ (remove-text-properties (point) run-end '(font-lock-face nil))
+ (put-text-property (point) run-end 'face face))
+ (goto-char run-end)))))
+
(unless (nth 2 handler) ;; NOEXCLUDE
(remove-yank-excluded-properties opoint (point)))
(if (eq yank-undo-function t) ;; not set by FUNCTION
BUFFER may be also nil, meaning that this process is not associated
with any buffer
COMMAND is the name of a shell command.
-Remaining arguments are the arguments for the command.
+Remaining arguments are the arguments for the command; they are all
+spliced together with blanks separating between each two of them, before
+passing the command to the shell.
Wildcards and redirection are handled as usual in the shell.
\(fn NAME BUFFER COMMAND &rest COMMAND-ARGS)"
;;;; 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))
The value returned is the value of the last form in BODY.
See also `with-temp-buffer'."
(declare (indent 1) (debug t))
- `(let ((save-selected-frame (selected-frame)))
- (unwind-protect
- (progn (select-frame ,frame)
- ,@body)
- (if (frame-live-p save-selected-frame)
- (select-frame save-selected-frame)))))
+ (let ((old-frame (make-symbol "old-frame"))
+ (old-buffer (make-symbol "old-buffer")))
+ `(let ((,old-frame (selected-frame))
+ (,old-buffer (current-buffer)))
+ (unwind-protect
+ (progn (select-frame ,frame)
+ ,@body)
+ (if (frame-live-p ,old-frame)
+ (select-frame ,old-frame))
+ (if (buffer-live-p ,old-buffer)
+ (set-buffer ,old-buffer))))))
(defmacro with-temp-file (file &rest body)
"Create a new buffer, evaluate BODY there, and write the buffer to FILE.
(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.
((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)
(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
(defvar version-regexp-alist
- '(("^[-_+]?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))
+ '(("^[-_+ ]?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))
"*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
HCoop / bpt / emacs.git / blobdiff