aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/subr.el83
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.
106Evaluate BODY with VAR bound to each car from LIST, in turn. 108Evaluate BODY with VAR bound to each car from LIST, in turn.
107Then evaluate RESULT to get return value, default nil." 109Then 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.
121Evaluate BODY with VAR bound to successive integers running from 0, 125Evaluate BODY with VAR bound to successive integers running from 0,
122inclusive, to COUNT, exclusive. Then evaluate RESULT to get 126inclusive, to COUNT, exclusive. Then evaluate RESULT to get
123the return value (nil if RESULT is omitted)." 127the 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.
208The comparison is done with `eq'." 215The comparison is done with `eq'. Contrary to `delq', this does not use
216side-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.
1235If you specify BUFFER, make a handle for BUFFER's state instead.
1236 1243
1237Pass the handle to `activate-change-group' afterward to initiate 1244Pass the handle to `activate-change-group' afterward to initiate
1238the actual changes of the change group. 1245the 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.
1599The value returned is the value of the last form in BODY. 1606The value returned is the value of the last form in BODY.
1600See also `with-temp-buffer'." 1607See 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.
1615The value returned is the value of the last form in BODY.
1616See 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'.
1648See also `with-temp-file' and `with-output-to-string'." 1665See 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
1687Do not alter `after-change-functions' or `before-change-functions' 1706Do not alter `after-change-functions' or `before-change-functions'
1688in BODY." 1707in 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