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."
(if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
x))))
-(defun number-sequence (from &optional to)
+(defun number-sequence (from &optional to inc)
"Return a sequence of numbers from FROM to TO (both inclusive) as a list.
-The Nth element of the list is (+ FROM N) where N counts from zero.
+INC is the increment used between numbers in the sequence.
+So, the Nth element of the list is (+ FROM (* N INC)) where N counts from
+zero.
+If INC is nil, it defaults to 1 (one).
If TO is nil, it defaults to FROM.
-If TO is less than FROM, the value is nil."
- (if to
- (if (< to from)
- (setq to (1- from)))
- (setq to from))
- (let* ((list (make-list (- (1+ to) from) from))
- (tail list))
- (while (setq tail (cdr tail))
- (setcar tail (setq from (1+ from))))
- list))
+If TO is less than FROM, the value is nil.
+Note that FROM, TO and INC can be integer or float."
+ (if (not to)
+ (list from)
+ (or inc (setq inc 1))
+ (let (seq)
+ (while (<= from to)
+ (setq seq (cons from seq)
+ from (+ from inc)))
+ (nreverse seq))))
(defun remove (elt seq)
"Return a copy of SEQ with all occurrences of ELT removed.
(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."
The optional argument PROMPT specifies a string to use to prompt the user.
The variable `read-quoted-char-radix' controls which radix to use
for numeric input."
- (let ((message-log-max nil) done (first t) (code 0) char)
+ (let ((message-log-max nil) done (first t) (code 0) char translated)
(while (not done)
(let ((inhibit-quit first)
;; Don't let C-h get the help message--only help function keys.
;; We could try and use read-key-sequence instead, but then C-q ESC
;; or C-q C-x might not return immediately since ESC or C-x might be
;; bound to some prefix in function-key-map or key-translation-map.
- (and char
- (let ((translated (lookup-key function-key-map (vector char))))
- (if (arrayp translated)
- (setq char (aref translated 0)))))
- (cond ((null char))
- ((not (integerp char))
- (setq unread-command-events (listify-key-sequence (this-single-command-raw-keys))
+ (setq translated char)
+ (let ((translation (lookup-key function-key-map (vector char))))
+ (if (arrayp translation)
+ (setq translated (aref translation 0))))
+ (cond ((null translated))
+ ((not (integerp translated))
+ (setq unread-command-events (list char)
done t))
- ((/= (logand char ?\M-\^@) 0)
+ ((/= (logand translated ?\M-\^@) 0)
;; Turn a meta-character into a character with the 0200 bit set.
- (setq code (logior (logand char (lognot ?\M-\^@)) 128)
+ (setq code (logior (logand translated (lognot ?\M-\^@)) 128)
done t))
- ((and (<= ?0 char) (< char (+ ?0 (min 10 read-quoted-char-radix))))
- (setq code (+ (* code read-quoted-char-radix) (- char ?0)))
- (and prompt (setq prompt (message "%s %c" prompt char))))
- ((and (<= ?a (downcase char))
- (< (downcase char) (+ ?a -10 (min 26 read-quoted-char-radix))))
+ ((and (<= ?0 translated) (< translated (+ ?0 (min 10 read-quoted-char-radix))))
+ (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 36 read-quoted-char-radix))))
(setq code (+ (* code read-quoted-char-radix)
- (+ 10 (- (downcase char) ?a))))
- (and prompt (setq prompt (message "%s %c" prompt char))))
- ((and (not first) (eq char ?\C-m))
+ (+ 10 (- (downcase translated) ?a))))
+ (and prompt (setq prompt (message "%s %c" prompt translated))))
+ ((and (not first) (eq translated ?\C-m))
(setq done t))
((not first)
- (setq unread-command-events (listify-key-sequence (this-single-command-raw-keys))
+ (setq unread-command-events (list char)
done t))
- (t (setq code char
+ (t (setq code translated
done t)))
(setq first nil))
code))
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