# HG changeset patch # User Stefan Monnier # Date 1053208840 0 # Node ID b39d8ed2d159d607c7df4d74b7743f70c3b6649e # Parent 5b8ca57f20c38fe237aa1d7faeead9a2175548ad (with-selected-window): New macro. (dolist, dotimes, with-current-buffer): Use backquotes. (when, unless, save-match-data, combine-after-change-calls) (with-output-to-string, with-temp-buffer): Add `declare' info. (listify-key-sequence): Don't allocate unnecessarily. (read-quoted-char): Allow up to base 36. (prepare-change-group): Remove unimplemented argument. diff -r 5b8ca57f20c3 -r b39d8ed2d159 lisp/subr.el --- a/lisp/subr.el Sat May 17 21:19:55 2003 +0000 +++ b/lisp/subr.el Sat May 17 22:00:40 2003 +0000 @@ -95,41 +95,48 @@ (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." @@ -204,8 +211,9 @@ (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)) @@ -565,7 +573,7 @@ (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." @@ -1140,7 +1148,7 @@ (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)))) @@ -1230,9 +1238,8 @@ (accept-change-group ,handle) (cancel-change-group ,handle)))))) -(defun prepare-change-group (&optional buffer) +(defun prepare-change-group () "Return a handle for the current buffer's state, for a change group. -If you specify BUFFER, make a handle for BUFFER's state instead. Pass the handle to `activate-change-group' afterward to initiate the actual changes of the change group. @@ -1598,9 +1605,19 @@ "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. @@ -1646,6 +1663,7 @@ (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*")))) @@ -1657,6 +1675,7 @@ (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)) @@ -1686,6 +1705,7 @@ 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) @@ -1760,6 +1780,7 @@ ;; 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