diff options
| -rw-r--r-- | lisp/subr.el | 83 |
1 files changed, 52 insertions, 31 deletions
diff --git a/lisp/subr.el b/lisp/subr.el index 8390d9c56dd..864af300e3e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -95,41 +95,48 @@ change the list." | |||
| 95 | 95 | ||
| 96 | (defmacro when (cond &rest body) | 96 | (defmacro when (cond &rest body) |
| 97 | "If COND yields non-nil, do BODY, else return nil." | 97 | "If COND yields non-nil, do BODY, else return nil." |
| 98 | (declare (indent 1) (debug t)) | ||
| 98 | (list 'if cond (cons 'progn body))) | 99 | (list 'if cond (cons 'progn body))) |
| 99 | 100 | ||
| 100 | (defmacro unless (cond &rest body) | 101 | (defmacro unless (cond &rest body) |
| 101 | "If COND yields nil, do BODY, else return nil." | 102 | "If COND yields nil, do BODY, else return nil." |
| 103 | (declare (indent 1) (debug t)) | ||
| 102 | (cons 'if (cons cond (cons nil body)))) | 104 | (cons 'if (cons cond (cons nil body)))) |
| 103 | 105 | ||
| 104 | (defmacro dolist (spec &rest body) | 106 | (defmacro dolist (spec &rest body) |
| 105 | "(dolist (VAR LIST [RESULT]) BODY...): loop over a list. | 107 | "Loop over a list. |
| 106 | Evaluate BODY with VAR bound to each car from LIST, in turn. | 108 | Evaluate BODY with VAR bound to each car from LIST, in turn. |
| 107 | Then evaluate RESULT to get return value, default nil." | 109 | Then evaluate RESULT to get return value, default nil. |
| 110 | |||
| 111 | \(dolist (VAR LIST [RESULT]) BODY...)" | ||
| 112 | (declare (indent 1) (debug ((symbolp form &optional form) body))) | ||
| 108 | (let ((temp (make-symbol "--dolist-temp--"))) | 113 | (let ((temp (make-symbol "--dolist-temp--"))) |
| 109 | (list 'let (list (list temp (nth 1 spec)) (car spec)) | 114 | `(let ((,temp ,(nth 1 spec)) |
| 110 | (list 'while temp | 115 | ,(car spec)) |
| 111 | (list 'setq (car spec) (list 'car temp)) | 116 | (while ,temp |
| 112 | (cons 'progn | 117 | (setq ,(car spec) (car ,temp)) |
| 113 | (append body | 118 | (setq ,temp (cdr ,temp)) |
| 114 | (list (list 'setq temp (list 'cdr temp)))))) | 119 | ,@body) |
| 115 | (if (cdr (cdr spec)) | 120 | ,@(if (cdr (cdr spec)) |
| 116 | (cons 'progn | 121 | `((setq ,(car spec) nil) ,@(cdr (cdr spec))))))) |
| 117 | (cons (list 'setq (car spec) nil) (cdr (cdr spec)))))))) | ||
| 118 | 122 | ||
| 119 | (defmacro dotimes (spec &rest body) | 123 | (defmacro dotimes (spec &rest body) |
| 120 | "(dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times. | 124 | "Loop a certain number of times. |
| 121 | Evaluate BODY with VAR bound to successive integers running from 0, | 125 | Evaluate BODY with VAR bound to successive integers running from 0, |
| 122 | inclusive, to COUNT, exclusive. Then evaluate RESULT to get | 126 | inclusive, to COUNT, exclusive. Then evaluate RESULT to get |
| 123 | the return value (nil if RESULT is omitted)." | 127 | the return value (nil if RESULT is omitted). |
| 124 | (let ((temp (make-symbol "--dotimes-temp--"))) | 128 | |
| 125 | (list 'let (list (list temp (nth 1 spec)) (list (car spec) 0)) | 129 | \(dotimes (VAR COUNT [RESULT]) BODY...)" |
| 126 | (list 'while (list '< (car spec) temp) | 130 | (declare (indent 1) (debug dolist)) |
| 127 | (cons 'progn | 131 | (let ((temp (make-symbol "--dotimes-temp--")) |
| 128 | (append body (list (list 'setq (car spec) | 132 | (start 0) |
| 129 | (list '1+ (car spec))))))) | 133 | (end (nth 1 spec))) |
| 130 | (if (cdr (cdr spec)) | 134 | `(let ((,temp ,end) |
| 131 | (car (cdr (cdr spec))) | 135 | (,(car spec) ,start)) |
| 132 | nil)))) | 136 | (while (< ,(car spec) ,temp) |
| 137 | ,@body | ||
| 138 | (setq ,(car spec) (1+ ,(car spec)))) | ||
| 139 | ,@(cdr (cdr spec))))) | ||
| 133 | 140 | ||
| 134 | (defsubst caar (x) | 141 | (defsubst caar (x) |
| 135 | "Return the car of the car of X." | 142 | "Return the car of the car of X." |
| @@ -204,8 +211,9 @@ SEQ must be a list, vector, or string. The comparison is done with `equal'." | |||
| 204 | (delete elt (copy-sequence seq)))) | 211 | (delete elt (copy-sequence seq)))) |
| 205 | 212 | ||
| 206 | (defun remq (elt list) | 213 | (defun remq (elt list) |
| 207 | "Return a copy of LIST with all occurrences of ELT removed. | 214 | "Return LIST with all occurrences of ELT removed. |
| 208 | The comparison is done with `eq'." | 215 | The comparison is done with `eq'. Contrary to `delq', this does not use |
| 216 | side-effects, and the argument LIST is not modified." | ||
| 209 | (if (memq elt list) | 217 | (if (memq elt list) |
| 210 | (delq elt (copy-sequence list)) | 218 | (delq elt (copy-sequence list)) |
| 211 | list)) | 219 | list)) |
| @@ -565,7 +573,7 @@ The normal global definition of the character C-x indirects to this keymap.") | |||
| 565 | (if (> c 127) | 573 | (if (> c 127) |
| 566 | (logxor c listify-key-sequence-1) | 574 | (logxor c listify-key-sequence-1) |
| 567 | c))) | 575 | c))) |
| 568 | (append key nil)))) | 576 | key))) |
| 569 | 577 | ||
| 570 | (defsubst eventp (obj) | 578 | (defsubst eventp (obj) |
| 571 | "True if the argument is an event object." | 579 | "True if the argument is an event object." |
| @@ -1140,7 +1148,7 @@ any other non-digit terminates the character code and is then used as input.")) | |||
| 1140 | (setq code (+ (* code read-quoted-char-radix) (- translated ?0))) | 1148 | (setq code (+ (* code read-quoted-char-radix) (- translated ?0))) |
| 1141 | (and prompt (setq prompt (message "%s %c" prompt translated)))) | 1149 | (and prompt (setq prompt (message "%s %c" prompt translated)))) |
| 1142 | ((and (<= ?a (downcase translated)) | 1150 | ((and (<= ?a (downcase translated)) |
| 1143 | (< (downcase translated) (+ ?a -10 (min 26 read-quoted-char-radix)))) | 1151 | (< (downcase translated) (+ ?a -10 (min 36 read-quoted-char-radix)))) |
| 1144 | (setq code (+ (* code read-quoted-char-radix) | 1152 | (setq code (+ (* code read-quoted-char-radix) |
| 1145 | (+ 10 (- (downcase translated) ?a)))) | 1153 | (+ 10 (- (downcase translated) ?a)))) |
| 1146 | (and prompt (setq prompt (message "%s %c" prompt translated)))) | 1154 | (and prompt (setq prompt (message "%s %c" prompt translated)))) |
| @@ -1230,9 +1238,8 @@ user can undo the change normally." | |||
| 1230 | (accept-change-group ,handle) | 1238 | (accept-change-group ,handle) |
| 1231 | (cancel-change-group ,handle)))))) | 1239 | (cancel-change-group ,handle)))))) |
| 1232 | 1240 | ||
| 1233 | (defun prepare-change-group (&optional buffer) | 1241 | (defun prepare-change-group () |
| 1234 | "Return a handle for the current buffer's state, for a change group. | 1242 | "Return a handle for the current buffer's state, for a change group. |
| 1235 | If you specify BUFFER, make a handle for BUFFER's state instead. | ||
| 1236 | 1243 | ||
| 1237 | Pass the handle to `activate-change-group' afterward to initiate | 1244 | Pass the handle to `activate-change-group' afterward to initiate |
| 1238 | the actual changes of the change group. | 1245 | the actual changes of the change group. |
| @@ -1598,9 +1605,19 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again." | |||
| 1598 | "Execute the forms in BODY with BUFFER as the current buffer. | 1605 | "Execute the forms in BODY with BUFFER as the current buffer. |
| 1599 | The value returned is the value of the last form in BODY. | 1606 | The value returned is the value of the last form in BODY. |
| 1600 | See also `with-temp-buffer'." | 1607 | See also `with-temp-buffer'." |
| 1601 | (cons 'save-current-buffer | 1608 | (declare (indent 1) (debug t)) |
| 1602 | (cons (list 'set-buffer buffer) | 1609 | `(save-current-buffer |
| 1603 | body))) | 1610 | (set-buffer ,buffer) |
| 1611 | ,@body)) | ||
| 1612 | |||
| 1613 | (defmacro with-selected-window (window &rest body) | ||
| 1614 | "Execute the forms in BODY with WINDOW as the selected window. | ||
| 1615 | The value returned is the value of the last form in BODY. | ||
| 1616 | See also `with-temp-buffer'." | ||
| 1617 | (declare (indent 1) (debug t)) | ||
| 1618 | `(save-selected-window | ||
| 1619 | (select-window ,window 'norecord) | ||
| 1620 | ,@body)) | ||
| 1604 | 1621 | ||
| 1605 | (defmacro with-temp-file (file &rest body) | 1622 | (defmacro with-temp-file (file &rest body) |
| 1606 | "Create a new buffer, evaluate BODY there, and write the buffer to FILE. | 1623 | "Create a new buffer, evaluate BODY there, and write the buffer to FILE. |
| @@ -1646,6 +1663,7 @@ Use a MESSAGE of \"\" to temporarily clear the echo area." | |||
| 1646 | (defmacro with-temp-buffer (&rest body) | 1663 | (defmacro with-temp-buffer (&rest body) |
| 1647 | "Create a temporary buffer, and evaluate BODY there like `progn'. | 1664 | "Create a temporary buffer, and evaluate BODY there like `progn'. |
| 1648 | See also `with-temp-file' and `with-output-to-string'." | 1665 | See also `with-temp-file' and `with-output-to-string'." |
| 1666 | (declare (indent 0) (debug t)) | ||
| 1649 | (let ((temp-buffer (make-symbol "temp-buffer"))) | 1667 | (let ((temp-buffer (make-symbol "temp-buffer"))) |
| 1650 | `(let ((,temp-buffer | 1668 | `(let ((,temp-buffer |
| 1651 | (get-buffer-create (generate-new-buffer-name " *temp*")))) | 1669 | (get-buffer-create (generate-new-buffer-name " *temp*")))) |
| @@ -1657,6 +1675,7 @@ See also `with-temp-file' and `with-output-to-string'." | |||
| 1657 | 1675 | ||
| 1658 | (defmacro with-output-to-string (&rest body) | 1676 | (defmacro with-output-to-string (&rest body) |
| 1659 | "Execute BODY, return the text it sent to `standard-output', as a string." | 1677 | "Execute BODY, return the text it sent to `standard-output', as a string." |
| 1678 | (declare (indent 0) (debug t)) | ||
| 1660 | `(let ((standard-output | 1679 | `(let ((standard-output |
| 1661 | (get-buffer-create (generate-new-buffer-name " *string-output*")))) | 1680 | (get-buffer-create (generate-new-buffer-name " *string-output*")))) |
| 1662 | (let ((standard-output standard-output)) | 1681 | (let ((standard-output standard-output)) |
| @@ -1686,6 +1705,7 @@ functions can't be deferred, so in that case this macro has no effect. | |||
| 1686 | 1705 | ||
| 1687 | Do not alter `after-change-functions' or `before-change-functions' | 1706 | Do not alter `after-change-functions' or `before-change-functions' |
| 1688 | in BODY." | 1707 | in BODY." |
| 1708 | (declare (indent 0) (debug t)) | ||
| 1689 | `(unwind-protect | 1709 | `(unwind-protect |
| 1690 | (let ((combine-after-change-calls t)) | 1710 | (let ((combine-after-change-calls t)) |
| 1691 | . ,body) | 1711 | . ,body) |
| @@ -1760,6 +1780,7 @@ The value returned is the value of the last form in BODY." | |||
| 1760 | ;; It is better not to use backquote here, | 1780 | ;; It is better not to use backquote here, |
| 1761 | ;; because that makes a bootstrapping problem | 1781 | ;; because that makes a bootstrapping problem |
| 1762 | ;; if you need to recompile all the Lisp files using interpreted code. | 1782 | ;; if you need to recompile all the Lisp files using interpreted code. |
| 1783 | (declare (indent 0) (debug t)) | ||
| 1763 | (list 'let | 1784 | (list 'let |
| 1764 | '((save-match-data-internal (match-data))) | 1785 | '((save-match-data-internal (match-data))) |
| 1765 | (list 'unwind-protect | 1786 | (list 'unwind-protect |