MACRO is the name of the macro being defined.
DECL is a list `(declare ...)' containing the declarations.
The return value of this function is not used."
- (dolist (d (cdr decl))
- (cond ((and (consp d) (eq (car d) 'indent))
- (put macro 'lisp-indent-function (cadr d)))
- ((and (consp d) (eq (car d) 'debug))
- (put macro 'edebug-form-spec (cadr d)))
- (t
- (message "Unknown declaration %s" d)))))
+ ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
+ (let (d)
+ ;; Ignore the first element of `decl' (it's always `declare').
+ (while (setq decl (cdr decl))
+ (setq d (car decl))
+ (cond ((and (consp d) (eq (car d) 'indent))
+ (put macro 'lisp-indent-function (car (cdr d))))
+ ((and (consp d) (eq (car d) 'debug))
+ (put macro 'edebug-form-spec (car (cdr d))))
+ (t
+ (message "Unknown declaration %s" d))))))
(setq macro-declaration-function 'macro-declaration-function)
(defmacro when (cond &rest body)
"If COND yields non-nil, do BODY, else return nil."
+ (declare (indent 1) (debug t))
(list 'if cond (cons 'progn body)))
(defmacro unless (cond &rest body)
"If COND yields nil, do BODY, else return nil."
+ (declare (indent 1) (debug t))
(cons 'if (cons cond (cons nil body))))
(defmacro dolist (spec &rest body)
- "(dolist (VAR LIST [RESULT]) BODY...): loop over a list.
+ "Loop over a list.
Evaluate BODY with VAR bound to each car from LIST, in turn.
-Then evaluate RESULT to get return value, default nil."
+Then evaluate RESULT to get return value, default nil.
+
+\(dolist (VAR LIST [RESULT]) BODY...)"
+ (declare (indent 1) (debug ((symbolp form &optional form) body)))
(let ((temp (make-symbol "--dolist-temp--")))
- (list 'let (list (list temp (nth 1 spec)) (car spec))
- (list 'while temp
- (list 'setq (car spec) (list 'car temp))
- (cons 'progn
- (append body
- (list (list 'setq temp (list 'cdr temp))))))
- (if (cdr (cdr spec))
- (cons 'progn
- (cons (list 'setq (car spec) nil) (cdr (cdr spec))))))))
+ `(let ((,temp ,(nth 1 spec))
+ ,(car spec))
+ (while ,temp
+ (setq ,(car spec) (car ,temp))
+ (setq ,temp (cdr ,temp))
+ ,@body)
+ ,@(if (cdr (cdr spec))
+ `((setq ,(car spec) nil) ,@(cdr (cdr spec)))))))
(defmacro dotimes (spec &rest body)
- "(dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times.
+ "Loop a certain number of times.
Evaluate BODY with VAR bound to successive integers running from 0,
inclusive, to COUNT, exclusive. Then evaluate RESULT to get
-the return value (nil if RESULT is omitted)."
- (let ((temp (make-symbol "--dotimes-temp--")))
- (list 'let (list (list temp (nth 1 spec)) (list (car spec) 0))
- (list 'while (list '< (car spec) temp)
- (cons 'progn
- (append body (list (list 'setq (car spec)
- (list '1+ (car spec)))))))
- (if (cdr (cdr spec))
- (car (cdr (cdr spec)))
- nil))))
+the return value (nil if RESULT is omitted).
+
+\(dotimes (VAR COUNT [RESULT]) BODY...)"
+ (declare (indent 1) (debug dolist))
+ (let ((temp (make-symbol "--dotimes-temp--"))
+ (start 0)
+ (end (nth 1 spec)))
+ `(let ((,temp ,end)
+ (,(car spec) ,start))
+ (while (< ,(car spec) ,temp)
+ ,@body
+ (setq ,(car spec) (1+ ,(car spec))))
+ ,@(cdr (cdr spec)))))
(defsubst caar (x)
"Return the car of the car of X."
(delete elt (copy-sequence seq))))
(defun remq (elt list)
- "Return a copy of LIST with all occurrences of ELT removed.
-The comparison is done with `eq'."
+ "Return LIST with all occurrences of ELT removed.
+The comparison is done with `eq'. Contrary to `delq', this does not use
+side-effects, and the argument LIST is not modified."
(if (memq elt list)
(delq elt (copy-sequence list))
list))
(if (> c 127)
(logxor c listify-key-sequence-1)
c)))
- (append key nil))))
+ key)))
(defsubst eventp (obj)
"True if the argument is an event object."
(setq code (+ (* code read-quoted-char-radix) (- translated ?0)))
(and prompt (setq prompt (message "%s %c" prompt translated))))
((and (<= ?a (downcase translated))
- (< (downcase translated) (+ ?a -10 (min 26 read-quoted-char-radix))))
+ (< (downcase translated) (+ ?a -10 (min 36 read-quoted-char-radix))))
(setq code (+ (* code read-quoted-char-radix)
(+ 10 (- (downcase translated) ?a))))
(and prompt (setq prompt (message "%s %c" prompt translated))))
call to `activate-change-group' and finish it with a single call
to `accept-change-group' or `cancel-change-group'."
- (list (cons (current-buffer) buffer-undo-list)))
+ (if buffer
+ (list (cons buffer (with-current-buffer buffer buffer-undo-list)))
+ (list (cons (current-buffer) buffer-undo-list))))
(defun activate-change-group (handle)
"Activate a change group made with `prepare-change-group' (which see)."
"Execute the forms in BODY with BUFFER as the current buffer.
The value returned is the value of the last form in BODY.
See also `with-temp-buffer'."
- (cons 'save-current-buffer
- (cons (list 'set-buffer buffer)
- body)))
+ (declare (indent 1) (debug t))
+ `(save-current-buffer
+ (set-buffer ,buffer)
+ ,@body))
+
+(defmacro with-selected-window (window &rest body)
+ "Execute the forms in BODY with WINDOW as the selected window.
+The value returned is the value of the last form in BODY.
+See also `with-temp-buffer'."
+ (declare (indent 1) (debug t))
+ `(save-selected-window
+ (select-window ,window 'norecord)
+ ,@body))
(defmacro with-temp-file (file &rest body)
"Create a new buffer, evaluate BODY there, and write the buffer to FILE.
(defmacro with-temp-buffer (&rest body)
"Create a temporary buffer, and evaluate BODY there like `progn'.
See also `with-temp-file' and `with-output-to-string'."
+ (declare (indent 0) (debug t))
(let ((temp-buffer (make-symbol "temp-buffer")))
`(let ((,temp-buffer
(get-buffer-create (generate-new-buffer-name " *temp*"))))
(defmacro with-output-to-string (&rest body)
"Execute BODY, return the text it sent to `standard-output', as a string."
+ (declare (indent 0) (debug t))
`(let ((standard-output
(get-buffer-create (generate-new-buffer-name " *string-output*"))))
(let ((standard-output standard-output))
Do not alter `after-change-functions' or `before-change-functions'
in BODY."
+ (declare (indent 0) (debug t))
`(unwind-protect
(let ((combine-after-change-calls t))
. ,body)
;; It is better not to use backquote here,
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
+ (declare (indent 0) (debug t))
(list 'let
'((save-match-data-internal (match-data)))
(list 'unwind-protect
(defun assq-delete-all (key alist)
"Delete from ALIST all elements whose car is KEY.
-Return the modified alist."
+Return the modified alist.
+Elements of ALIST that are not conses are ignored."
(let ((tail alist))
(while tail
- (if (eq (car (car tail)) key)
+ (if (and (consp (car tail)) (eq (car (car tail)) key))
(setq alist (delq (car tail) alist)))
(setq tail (cdr tail)))
alist))
(set-default-file-modes umask))))
\f
+;; If a minor mode is not defined with define-minor-mode,
+;; add it here explicitly.
+;; isearch-mode is deliberately excluded, since you should
+;; not call it yourself.
+(defvar minor-mode-list '(auto-save-mode auto-fill-mode abbrev-mode
+ overwrite-mode view-mode)
+ "List of all minor mode functions.")
+
(defun add-minor-mode (toggle name &optional keymap after toggle-fun)
"Register a new minor mode.
If TOGGLE has a non-nil `:included' property, an entry for the mode is
included in the mode-line minor mode menu.
If TOGGLE has a `:menu-tag', that is used for the menu item's label."
+ (unless (memq toggle minor-mode-list)
+ (push toggle minor-mode-list))
+
(unless toggle-fun (setq toggle-fun toggle))
;; Add the name to the minor-mode-alist.
(when name