Mercurial > emacs

comparison lisp/simple.el @ 83238:223c12363c0c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merged in changes from CVS trunk. Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-747 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-748 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-749 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-751 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-752 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-78 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-79 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-80 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-278
author Karoly Lorentey <lorentey@elte.hu>
date Thu, 06 Jan 2005 15:00:09 +0000
parents 4ee39d9428b0 349f61f37d67
children 025da3ba778e
comparison
equal deleted inserted replaced
83237:4ee39d9428b0 83238:223c12363c0c
122 to navigate in it.") 122 to navigate in it.")
123 123
124 (make-variable-buffer-local 'next-error-function) 124 (make-variable-buffer-local 'next-error-function)
125 125
126 (defsubst next-error-buffer-p (buffer 126 (defsubst next-error-buffer-p (buffer
127 &optional 127 &optional avoid-current
128 extra-test-inclusive 128 extra-test-inclusive
129 extra-test-exclusive) 129 extra-test-exclusive)
130 "Test if BUFFER is a next-error capable buffer. 130 "Test if BUFFER is a next-error capable buffer.
131 EXTRA-TEST-INCLUSIVE is called to allow extra buffers. 131
132 EXTRA-TEST-EXCLUSIVE is called to disallow buffers." 132 If AVOID-CURRENT is non-nil, treat the current buffer
133 (with-current-buffer buffer 133 as an absolute last resort only.
134 (or (and extra-test-inclusive (funcall extra-test-inclusive)) 134
135 (and (if extra-test-exclusive (funcall extra-test-exclusive) t) 135 The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
136 next-error-function)))) 136 that normally would not qualify. If it returns t, the buffer
137 137 in question is treated as usable.
138 (defun next-error-find-buffer (&optional other-buffer 138
139 The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer
140 that would normally be considered usable. if it returns nil,
141 that buffer is rejected."
142 (and (buffer-name buffer) ;First make sure it's live.
143 (not (and avoid-current (eq buffer (current-buffer))))
144 (with-current-buffer buffer
145 (if next-error-function ; This is the normal test.
146 ;; Optionally reject some buffers.
147 (if extra-test-exclusive
148 (funcall extra-test-exclusive)
149 t)
150 ;; Optionally accept some other buffers.
151 (and extra-test-inclusive
152 (funcall extra-test-inclusive))))))
153
154 (defun next-error-find-buffer (&optional avoid-current
139 extra-test-inclusive 155 extra-test-inclusive
140 extra-test-exclusive) 156 extra-test-exclusive)
141 "Return a next-error capable buffer. 157 "Return a next-error capable buffer.
142 OTHER-BUFFER will disallow the current buffer. 158 If AVOID-CURRENT is non-nil, treat the current buffer
143 EXTRA-TEST-INCLUSIVE is called to allow extra buffers. 159 as an absolute last resort only.
144 EXTRA-TEST-EXCLUSIVE is called to disallow buffers." 160
161 The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffers
162 that normally would not qualify. If it returns t, the buffer
163 in question is treated as usable.
164
165 The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer
166 that would normally be considered usable. If it returns nil,
167 that buffer is rejected."
145 (or 168 (or
146 ;; 1. If one window on the selected frame displays such buffer, return it. 169 ;; 1. If one window on the selected frame displays such buffer, return it.
147 (let ((window-buffers 170 (let ((window-buffers
148 (delete-dups 171 (delete-dups
149 (delq nil (mapcar (lambda (w) 172 (delq nil (mapcar (lambda (w)
150 (if (next-error-buffer-p 173 (if (next-error-buffer-p
151 (window-buffer w) 174 (window-buffer w)
175 avoid-current
152 extra-test-inclusive extra-test-exclusive) 176 extra-test-inclusive extra-test-exclusive)
153 (window-buffer w))) 177 (window-buffer w)))
154 (window-list)))))) 178 (window-list))))))
155 (if other-buffer
156 (setq window-buffers (delq (current-buffer) window-buffers)))
157 (if (eq (length window-buffers) 1) 179 (if (eq (length window-buffers) 1)
158 (car window-buffers))) 180 (car window-buffers)))
159 ;; 2. If next-error-last-buffer is set to a live buffer, use that. 181 ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
160 (if (and next-error-last-buffer 182 (if (and next-error-last-buffer
161 (buffer-name next-error-last-buffer) 183 (next-error-buffer-p next-error-last-buffer avoid-current
162 (next-error-buffer-p next-error-last-buffer 184 extra-test-inclusive extra-test-exclusive))
163 extra-test-inclusive extra-test-exclusive)
164 (or (not other-buffer)
165 (not (eq next-error-last-buffer (current-buffer)))))
166 next-error-last-buffer) 185 next-error-last-buffer)
167 ;; 3. If the current buffer is a next-error capable buffer, return it. 186 ;; 3. If the current buffer is acceptable, choose it.
168 (if (and (not other-buffer) 187 (if (next-error-buffer-p (current-buffer) avoid-current
169 (next-error-buffer-p (current-buffer) 188 extra-test-inclusive extra-test-exclusive)
170 extra-test-inclusive extra-test-exclusive))
171 (current-buffer)) 189 (current-buffer))
172 ;; 4. Look for a next-error capable buffer in a buffer list. 190 ;; 4. Look for any acceptable buffer.
173 (let ((buffers (buffer-list))) 191 (let ((buffers (buffer-list)))
174 (while (and buffers 192 (while (and buffers
175 (or (not (next-error-buffer-p 193 (not (next-error-buffer-p
176 (car buffers) 194 (car buffers) avoid-current
177 extra-test-inclusive extra-test-exclusive)) 195 extra-test-inclusive extra-test-exclusive)))
178 (and other-buffer (eq (car buffers) (current-buffer)))))
179 (setq buffers (cdr buffers))) 196 (setq buffers (cdr buffers)))
180 (if buffers 197 (car buffers))
181 (car buffers) 198 ;; 5. Use the current buffer as a last resort if it qualifies,
182 (or (and other-buffer 199 ;; even despite AVOID-CURRENT.
183 (next-error-buffer-p (current-buffer) 200 (and avoid-current
184 extra-test-inclusive extra-test-exclusive) 201 (next-error-buffer-p (current-buffer) nil
185 ;; The current buffer is a next-error capable buffer. 202 extra-test-inclusive extra-test-exclusive)
186 (progn 203 (progn
187 (if other-buffer 204 (message "This is the only next-error capable buffer")
188 (message "This is the only next-error capable buffer")) 205 (current-buffer)))
189 (current-buffer))) 206 ;; 6. Give up.
190 (error "No next-error capable buffer found")))))) 207 (error "No next-error capable buffer found")))
191 208
192 (defun next-error (&optional arg reset) 209 (defun next-error (&optional arg reset)
193 "Visit next next-error message and corresponding source code. 210 "Visit next next-error message and corresponding source code.
194 211
195 If all the error messages parsed so far have been processed already, 212 If all the error messages parsed so far have been processed already,
1111 (let* ((enable-recursive-minibuffers t) 1128 (let* ((enable-recursive-minibuffers t)
1112 (regexp (read-from-minibuffer "Next element matching (regexp): " 1129 (regexp (read-from-minibuffer "Next element matching (regexp): "
1113 nil 1130 nil
1114 minibuffer-local-map 1131 minibuffer-local-map
1115 nil 1132 nil
1116 'minibuffer-history-search-history))) 1133 'minibuffer-history-search-history
1134 (car minibuffer-history-search-history))))
1117 ;; Use the last regexp specified, by default, if input is empty. 1135 ;; Use the last regexp specified, by default, if input is empty.
1118 (list (if (string= regexp "") 1136 (list (if (string= regexp "")
1119 (setcar minibuffer-history-search-history 1137 (if minibuffer-history-search-history
1120 (nth 1 minibuffer-history-search-history)) 1138 (car minibuffer-history-search-history)
1139 (error "No previous history search regexp"))
1121 regexp) 1140 regexp)
1122 (prefix-numeric-value current-prefix-arg)))) 1141 (prefix-numeric-value current-prefix-arg))))
1123 (previous-matching-history-element regexp (- n))) 1142 (previous-matching-history-element regexp (- n)))
1124 1143
1125 (defvar minibuffer-temporary-goal-position nil) 1144 (defvar minibuffer-temporary-goal-position nil)
1213 "Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.") 1232 "Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.")
1214 1233
1215 (defvar undo-no-redo nil 1234 (defvar undo-no-redo nil
1216 "If t, `undo' doesn't go through redo entries.") 1235 "If t, `undo' doesn't go through redo entries.")
1217 1236
1237 (defvar undo-list-saved nil
1238 "The value of `buffer-undo-list' saved by the last undo command.")
1239 (make-variable-buffer-local 'undo-list-saved)
1240
1218 (defun undo (&optional arg) 1241 (defun undo (&optional arg)
1219 "Undo some previous changes. 1242 "Undo some previous changes.
1220 Repeat this command to undo more changes. 1243 Repeat this command to undo more changes.
1221 A numeric argument serves as a repeat count. 1244 A numeric argument serves as a repeat count.
1222 1245
1235 ;; If we get an error in undo-start, 1258 ;; If we get an error in undo-start,
1236 ;; the next command should not be a "consecutive undo". 1259 ;; the next command should not be a "consecutive undo".
1237 ;; So set `this-command' to something other than `undo'. 1260 ;; So set `this-command' to something other than `undo'.
1238 (setq this-command 'undo-start) 1261 (setq this-command 'undo-start)
1239 1262
1240 (unless (eq last-command 'undo) 1263 (unless (and (eq last-command 'undo)
1264 ;; If something (a timer or filter?) changed the buffer
1265 ;; since the previous command, don't continue the undo seq.
1266 (let ((list buffer-undo-list))
1267 (while (eq (car list) nil)
1268 (setq list (cdr list)))
1269 (eq undo-list-saved list)))
1241 (setq undo-in-region 1270 (setq undo-in-region
1242 (if transient-mark-mode mark-active (and arg (not (numberp arg))))) 1271 (if transient-mark-mode mark-active (and arg (not (numberp arg)))))
1243 (if undo-in-region 1272 (if undo-in-region
1244 (undo-start (region-beginning) (region-end)) 1273 (undo-start (region-beginning) (region-end))
1245 (undo-start)) 1274 (undo-start))
1287 (setq buffer-undo-list (cdr tail))) 1316 (setq buffer-undo-list (cdr tail)))
1288 (setq prev tail)) 1317 (setq prev tail))
1289 (setq tail (cdr tail))) 1318 (setq tail (cdr tail)))
1290 (setq tail nil))) 1319 (setq tail nil)))
1291 (setq prev tail tail (cdr tail)))) 1320 (setq prev tail tail (cdr tail))))
1292 1321 ;; Record what the current undo list says,
1322 ;; so the next command can tell if the buffer was modified in between.
1323 (setq undo-list-saved buffer-undo-list)
1293 (and modified (not (buffer-modified-p)) 1324 (and modified (not (buffer-modified-p))
1294 (delete-auto-save-file-if-necessary recent-save)))) 1325 (delete-auto-save-file-if-necessary recent-save))))
1326
1327 (defun buffer-disable-undo (&optional buffer)
1328 "Make BUFFER stop keeping undo information.
1329 No argument or nil as argument means do this for the current buffer."
1330 (interactive)
1331 (with-current-buffer (get-buffer buffer)
1332 (setq buffer-undo-list t
1333 undo-list-saved nil)))
1295 1334
1296 (defun undo-only (&optional arg) 1335 (defun undo-only (&optional arg)
1297 "Undo some previous changes. 1336 "Undo some previous changes.
1298 Repeat this command to undo more changes. 1337 Repeat this command to undo more changes.
1299 A numeric argument serves as a repeat count. 1338 A numeric argument serves as a repeat count.
1489 ;; this function gets called to ask the user what to do. 1528 ;; this function gets called to ask the user what to do.
1490 ;; Garbage collection is inhibited around the call, 1529 ;; Garbage collection is inhibited around the call,
1491 ;; so it had better not do a lot of consing. 1530 ;; so it had better not do a lot of consing.
1492 (setq undo-outer-limit-function 'undo-outer-limit-truncate) 1531 (setq undo-outer-limit-function 'undo-outer-limit-truncate)
1493 (defun undo-outer-limit-truncate (size) 1532 (defun undo-outer-limit-truncate (size)
1494 (if (yes-or-no-p (format "Buffer %s undo info is %d bytes long; discard it? " 1533 (if (let (use-dialog-box)
1495 (buffer-name) size)) 1534 (yes-or-no-p (format "Buffer %s undo info is %d bytes long; discard it? "
1535 (buffer-name) size)))
1496 (progn (setq buffer-undo-list nil) t) 1536 (progn (setq buffer-undo-list nil) t)
1497 nil)) 1537 nil))
1498 1538
1499 (defvar shell-command-history nil 1539 (defvar shell-command-history nil
1500 "History list for some commands that read shell commands.") 1540 "History list for some commands that read shell commands.")