Mercurial > emacs
comparison lisp/simple.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 48e671543e1e |
children |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
1 ;;; simple.el --- basic editing commands for Emacs | 1 ;;; simple.el --- basic editing commands for Emacs |
2 | 2 |
3 ;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, | 3 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999, |
4 ;; 2000, 2001, 2002, 2003 | 4 ;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. |
5 ;; Free Software Foundation, Inc. | |
6 | 5 |
7 ;; Maintainer: FSF | 6 ;; Maintainer: FSF |
8 ;; Keywords: internal | 7 ;; Keywords: internal |
9 | 8 |
10 ;; This file is part of GNU Emacs. | 9 ;; This file is part of GNU Emacs. |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
20 ;; GNU General Public License for more details. | 19 ;; GNU General Public License for more details. |
21 | 20 |
22 ;; You should have received a copy of the GNU General Public License | 21 ;; You should have received a copy of the GNU General Public License |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 ;; Boston, MA 02111-1307, USA. | 24 ;; Boston, MA 02110-1301, USA. |
26 | 25 |
27 ;;; Commentary: | 26 ;;; Commentary: |
28 | 27 |
29 ;; A grab-bag of basic Emacs commands not specifically related to some | 28 ;; A grab-bag of basic Emacs commands not specifically related to some |
30 ;; major mode or to file-handling. | 29 ;; major mode or to file-handling. |
33 | 32 |
34 (eval-when-compile | 33 (eval-when-compile |
35 (autoload 'widget-convert "wid-edit") | 34 (autoload 'widget-convert "wid-edit") |
36 (autoload 'shell-mode "shell")) | 35 (autoload 'shell-mode "shell")) |
37 | 36 |
37 (defvar compilation-current-error) | |
38 | |
39 (defcustom idle-update-delay 0.5 | |
40 "*Idle time delay before updating various things on the screen. | |
41 Various Emacs features that update auxiliary information when point moves | |
42 wait this many seconds after Emacs becomes idle before doing an update." | |
43 :type 'number | |
44 :group 'display | |
45 :version "22.1") | |
38 | 46 |
39 (defgroup killing nil | 47 (defgroup killing nil |
40 "Killing and yanking commands" | 48 "Killing and yanking commands." |
41 :group 'editing) | 49 :group 'editing) |
42 | 50 |
43 (defgroup paren-matching nil | 51 (defgroup paren-matching nil |
44 "Highlight (un)matching of parens and expressions." | 52 "Highlight (un)matching of parens and expressions." |
45 :group 'matching) | 53 :group 'matching) |
46 | 54 |
47 (define-key global-map [?\C-x right] 'next-buffer) | 55 (defun get-next-valid-buffer (list &optional buffer visible-ok frame) |
48 (define-key global-map [?\C-x left] 'prev-buffer) | 56 "Search LIST for a valid buffer to display in FRAME. |
57 Return nil when all buffers in LIST are undesirable for display, | |
58 otherwise return the first suitable buffer in LIST. | |
59 | |
60 Buffers not visible in windows are preferred to visible buffers, | |
61 unless VISIBLE-OK is non-nil. | |
62 If the optional argument FRAME is nil, it defaults to the selected frame. | |
63 If BUFFER is non-nil, ignore occurrences of that buffer in LIST." | |
64 ;; This logic is more or less copied from other-buffer. | |
65 (setq frame (or frame (selected-frame))) | |
66 (let ((pred (frame-parameter frame 'buffer-predicate)) | |
67 found buf) | |
68 (while (and (not found) list) | |
69 (setq buf (car list)) | |
70 (if (and (not (eq buffer buf)) | |
71 (buffer-live-p buf) | |
72 (or (null pred) (funcall pred buf)) | |
73 (not (eq (aref (buffer-name buf) 0) ?\s)) | |
74 (or visible-ok (null (get-buffer-window buf 'visible)))) | |
75 (setq found buf) | |
76 (setq list (cdr list)))) | |
77 (car list))) | |
78 | |
79 (defun last-buffer (&optional buffer visible-ok frame) | |
80 "Return the last non-hidden displayable buffer in the buffer list. | |
81 If BUFFER is non-nil, last-buffer will ignore that buffer. | |
82 Buffers not visible in windows are preferred to visible buffers, | |
83 unless optional argument VISIBLE-OK is non-nil. | |
84 If the optional third argument FRAME is non-nil, use that frame's | |
85 buffer list instead of the selected frame's buffer list. | |
86 If no other buffer exists, the buffer `*scratch*' is returned." | |
87 (setq frame (or frame (selected-frame))) | |
88 (or (get-next-valid-buffer (frame-parameter frame 'buried-buffer-list) | |
89 buffer visible-ok frame) | |
90 (get-next-valid-buffer (nreverse (buffer-list frame)) | |
91 buffer visible-ok frame) | |
92 (progn | |
93 (set-buffer-major-mode (get-buffer-create "*scratch*")) | |
94 (get-buffer "*scratch*")))) | |
95 | |
49 (defun next-buffer () | 96 (defun next-buffer () |
50 "Switch to the next buffer in cyclic order." | 97 "Switch to the next buffer in cyclic order." |
51 (interactive) | 98 (interactive) |
52 (let ((buffer (current-buffer))) | 99 (let ((buffer (current-buffer)) |
53 (switch-to-buffer (other-buffer buffer)) | 100 (bbl (frame-parameter nil 'buried-buffer-list))) |
54 (bury-buffer buffer))) | 101 (switch-to-buffer (other-buffer buffer t)) |
55 | 102 (bury-buffer buffer) |
56 (defun prev-buffer () | 103 (set-frame-parameter nil 'buried-buffer-list |
104 (cons buffer (delq buffer bbl))))) | |
105 | |
106 (defun previous-buffer () | |
57 "Switch to the previous buffer in cyclic order." | 107 "Switch to the previous buffer in cyclic order." |
58 (interactive) | 108 (interactive) |
59 (let ((list (nreverse (buffer-list))) | 109 (let ((buffer (last-buffer (current-buffer) t)) |
60 found) | 110 (bbl (frame-parameter nil 'buried-buffer-list))) |
61 (while (and (not found) list) | 111 (switch-to-buffer buffer) |
62 (let ((buffer (car list))) | 112 ;; Clean up buried-buffer-list up to and including the chosen buffer. |
63 (if (and (not (get-buffer-window buffer)) | 113 (while (and bbl (not (eq (car bbl) buffer))) |
64 (not (string-match "\\` " (buffer-name buffer)))) | 114 (setq bbl (cdr bbl))) |
65 (setq found buffer))) | 115 (set-frame-parameter nil 'buried-buffer-list bbl))) |
66 (setq list (cdr list))) | 116 |
67 (switch-to-buffer found))) | 117 |
118 ;;; next-error support framework | |
119 | |
120 (defgroup next-error nil | |
121 "`next-error' support framework." | |
122 :group 'compilation | |
123 :version "22.1") | |
124 | |
125 (defface next-error | |
126 '((t (:inherit region))) | |
127 "Face used to highlight next error locus." | |
128 :group 'next-error | |
129 :version "22.1") | |
130 | |
131 (defcustom next-error-highlight 0.1 | |
132 "*Highlighting of locations in selected source buffers. | |
133 If number, highlight the locus in `next-error' face for given time in seconds. | |
134 If t, use persistent overlays fontified in `next-error' face. | |
135 If nil, don't highlight the locus in the source buffer. | |
136 If `fringe-arrow', indicate the locus by the fringe arrow." | |
137 :type '(choice (number :tag "Delay") | |
138 (const :tag "Persistent overlay" t) | |
139 (const :tag "No highlighting" nil) | |
140 (const :tag "Fringe arrow" 'fringe-arrow)) | |
141 :group 'next-error | |
142 :version "22.1") | |
143 | |
144 (defcustom next-error-highlight-no-select 0.1 | |
145 "*Highlighting of locations in non-selected source buffers. | |
146 If number, highlight the locus in `next-error' face for given time in seconds. | |
147 If t, use persistent overlays fontified in `next-error' face. | |
148 If nil, don't highlight the locus in the source buffer. | |
149 If `fringe-arrow', indicate the locus by the fringe arrow." | |
150 :type '(choice (number :tag "Delay") | |
151 (const :tag "Persistent overlay" t) | |
152 (const :tag "No highlighting" nil) | |
153 (const :tag "Fringe arrow" 'fringe-arrow)) | |
154 :group 'next-error | |
155 :version "22.1") | |
156 | |
157 (defcustom next-error-hook nil | |
158 "*List of hook functions run by `next-error' after visiting source file." | |
159 :type 'hook | |
160 :group 'next-error) | |
161 | |
162 (defvar next-error-highlight-timer nil) | |
163 | |
164 (defvar next-error-overlay-arrow-position nil) | |
165 (put 'next-error-overlay-arrow-position 'overlay-arrow-string "=>") | |
166 (add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position) | |
167 | |
168 (defvar next-error-last-buffer nil | |
169 "The most recent `next-error' buffer. | |
170 A buffer becomes most recent when its compilation, grep, or | |
171 similar mode is started, or when it is used with \\[next-error] | |
172 or \\[compile-goto-error].") | |
173 | |
174 (defvar next-error-function nil | |
175 "Function to use to find the next error in the current buffer. | |
176 The function is called with 2 parameters: | |
177 ARG is an integer specifying by how many errors to move. | |
178 RESET is a boolean which, if non-nil, says to go back to the beginning | |
179 of the errors before moving. | |
180 Major modes providing compile-like functionality should set this variable | |
181 to indicate to `next-error' that this is a candidate buffer and how | |
182 to navigate in it.") | |
183 | |
184 (make-variable-buffer-local 'next-error-function) | |
185 | |
186 (defsubst next-error-buffer-p (buffer | |
187 &optional avoid-current | |
188 extra-test-inclusive | |
189 extra-test-exclusive) | |
190 "Test if BUFFER is a `next-error' capable buffer. | |
191 | |
192 If AVOID-CURRENT is non-nil, treat the current buffer | |
193 as an absolute last resort only. | |
194 | |
195 The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer | |
196 that normally would not qualify. If it returns t, the buffer | |
197 in question is treated as usable. | |
198 | |
199 The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer | |
200 that would normally be considered usable. If it returns nil, | |
201 that buffer is rejected." | |
202 (and (buffer-name buffer) ;First make sure it's live. | |
203 (not (and avoid-current (eq buffer (current-buffer)))) | |
204 (with-current-buffer buffer | |
205 (if next-error-function ; This is the normal test. | |
206 ;; Optionally reject some buffers. | |
207 (if extra-test-exclusive | |
208 (funcall extra-test-exclusive) | |
209 t) | |
210 ;; Optionally accept some other buffers. | |
211 (and extra-test-inclusive | |
212 (funcall extra-test-inclusive)))))) | |
213 | |
214 (defun next-error-find-buffer (&optional avoid-current | |
215 extra-test-inclusive | |
216 extra-test-exclusive) | |
217 "Return a `next-error' capable buffer. | |
218 | |
219 If AVOID-CURRENT is non-nil, treat the current buffer | |
220 as an absolute last resort only. | |
221 | |
222 The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer | |
223 that normally would not qualify. If it returns t, the buffer | |
224 in question is treated as usable. | |
225 | |
226 The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer | |
227 that would normally be considered usable. If it returns nil, | |
228 that buffer is rejected." | |
229 (or | |
230 ;; 1. If one window on the selected frame displays such buffer, return it. | |
231 (let ((window-buffers | |
232 (delete-dups | |
233 (delq nil (mapcar (lambda (w) | |
234 (if (next-error-buffer-p | |
235 (window-buffer w) | |
236 avoid-current | |
237 extra-test-inclusive extra-test-exclusive) | |
238 (window-buffer w))) | |
239 (window-list)))))) | |
240 (if (eq (length window-buffers) 1) | |
241 (car window-buffers))) | |
242 ;; 2. If next-error-last-buffer is an acceptable buffer, use that. | |
243 (if (and next-error-last-buffer | |
244 (next-error-buffer-p next-error-last-buffer avoid-current | |
245 extra-test-inclusive extra-test-exclusive)) | |
246 next-error-last-buffer) | |
247 ;; 3. If the current buffer is acceptable, choose it. | |
248 (if (next-error-buffer-p (current-buffer) avoid-current | |
249 extra-test-inclusive extra-test-exclusive) | |
250 (current-buffer)) | |
251 ;; 4. Look for any acceptable buffer. | |
252 (let ((buffers (buffer-list))) | |
253 (while (and buffers | |
254 (not (next-error-buffer-p | |
255 (car buffers) avoid-current | |
256 extra-test-inclusive extra-test-exclusive))) | |
257 (setq buffers (cdr buffers))) | |
258 (car buffers)) | |
259 ;; 5. Use the current buffer as a last resort if it qualifies, | |
260 ;; even despite AVOID-CURRENT. | |
261 (and avoid-current | |
262 (next-error-buffer-p (current-buffer) nil | |
263 extra-test-inclusive extra-test-exclusive) | |
264 (progn | |
265 (message "This is the only next-error capable buffer") | |
266 (current-buffer))) | |
267 ;; 6. Give up. | |
268 (error "No next-error capable buffer found"))) | |
269 | |
270 (defun next-error (&optional arg reset) | |
271 "Visit next `next-error' message and corresponding source code. | |
272 | |
273 If all the error messages parsed so far have been processed already, | |
274 the message buffer is checked for new ones. | |
275 | |
276 A prefix ARG specifies how many error messages to move; | |
277 negative means move back to previous error messages. | |
278 Just \\[universal-argument] as a prefix means reparse the error message buffer | |
279 and start at the first error. | |
280 | |
281 The RESET argument specifies that we should restart from the beginning. | |
282 | |
283 \\[next-error] normally uses the most recently started | |
284 compilation, grep, or occur buffer. It can also operate on any | |
285 buffer with output from the \\[compile], \\[grep] commands, or, | |
286 more generally, on any buffer in Compilation mode or with | |
287 Compilation Minor mode enabled, or any buffer in which | |
288 `next-error-function' is bound to an appropriate function. | |
289 To specify use of a particular buffer for error messages, type | |
290 \\[next-error] in that buffer when it is the only one displayed | |
291 in the current frame. | |
292 | |
293 Once \\[next-error] has chosen the buffer for error messages, it | |
294 runs `next-error-hook' with `run-hooks', and stays with that buffer | |
295 until you use it in some other buffer which uses Compilation mode | |
296 or Compilation Minor mode. | |
297 | |
298 See variables `compilation-parse-errors-function' and | |
299 \`compilation-error-regexp-alist' for customization ideas." | |
300 (interactive "P") | |
301 (if (consp arg) (setq reset t arg nil)) | |
302 (when (setq next-error-last-buffer (next-error-find-buffer)) | |
303 ;; we know here that next-error-function is a valid symbol we can funcall | |
304 (with-current-buffer next-error-last-buffer | |
305 (funcall next-error-function (prefix-numeric-value arg) reset) | |
306 (run-hooks 'next-error-hook)))) | |
307 | |
308 (defun next-error-internal () | |
309 "Visit the source code corresponding to the `next-error' message at point." | |
310 (setq next-error-last-buffer (current-buffer)) | |
311 ;; we know here that next-error-function is a valid symbol we can funcall | |
312 (with-current-buffer next-error-last-buffer | |
313 (funcall next-error-function 0 nil) | |
314 (run-hooks 'next-error-hook))) | |
315 | |
316 (defalias 'goto-next-locus 'next-error) | |
317 (defalias 'next-match 'next-error) | |
318 | |
319 (defun previous-error (&optional n) | |
320 "Visit previous `next-error' message and corresponding source code. | |
321 | |
322 Prefix arg N says how many error messages to move backwards (or | |
323 forwards, if negative). | |
324 | |
325 This operates on the output from the \\[compile] and \\[grep] commands." | |
326 (interactive "p") | |
327 (next-error (- (or n 1)))) | |
328 | |
329 (defun first-error (&optional n) | |
330 "Restart at the first error. | |
331 Visit corresponding source code. | |
332 With prefix arg N, visit the source code of the Nth error. | |
333 This operates on the output from the \\[compile] command, for instance." | |
334 (interactive "p") | |
335 (next-error n t)) | |
336 | |
337 (defun next-error-no-select (&optional n) | |
338 "Move point to the next error in the `next-error' buffer and highlight match. | |
339 Prefix arg N says how many error messages to move forwards (or | |
340 backwards, if negative). | |
341 Finds and highlights the source line like \\[next-error], but does not | |
342 select the source buffer." | |
343 (interactive "p") | |
344 (let ((next-error-highlight next-error-highlight-no-select)) | |
345 (next-error n)) | |
346 (pop-to-buffer next-error-last-buffer)) | |
347 | |
348 (defun previous-error-no-select (&optional n) | |
349 "Move point to the previous error in the `next-error' buffer and highlight match. | |
350 Prefix arg N says how many error messages to move backwards (or | |
351 forwards, if negative). | |
352 Finds and highlights the source line like \\[previous-error], but does not | |
353 select the source buffer." | |
354 (interactive "p") | |
355 (next-error-no-select (- (or n 1)))) | |
356 | |
357 ;;; Internal variable for `next-error-follow-mode-post-command-hook'. | |
358 (defvar next-error-follow-last-line nil) | |
359 | |
360 (define-minor-mode next-error-follow-minor-mode | |
361 "Minor mode for compilation, occur and diff modes. | |
362 When turned on, cursor motion in the compilation, grep, occur or diff | |
363 buffer causes automatic display of the corresponding source code | |
364 location." | |
365 :group 'next-error :init-value nil :lighter " Fol" | |
366 (if (not next-error-follow-minor-mode) | |
367 (remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t) | |
368 (add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t) | |
369 (make-local-variable 'next-error-follow-last-line))) | |
370 | |
371 ;;; Used as a `post-command-hook' by `next-error-follow-mode' | |
372 ;;; for the *Compilation* *grep* and *Occur* buffers. | |
373 (defun next-error-follow-mode-post-command-hook () | |
374 (unless (equal next-error-follow-last-line (line-number-at-pos)) | |
375 (setq next-error-follow-last-line (line-number-at-pos)) | |
376 (condition-case nil | |
377 (let ((compilation-context-lines nil)) | |
378 (setq compilation-current-error (point)) | |
379 (next-error-no-select 0)) | |
380 (error t)))) | |
381 | |
382 | |
383 ;;; | |
68 | 384 |
69 (defun fundamental-mode () | 385 (defun fundamental-mode () |
70 "Major mode not specialized for anything in particular. | 386 "Major mode not specialized for anything in particular. |
71 Other major modes are defined by comparison with this one." | 387 Other major modes are defined by comparison with this one." |
72 (interactive) | 388 (interactive) |
73 (kill-all-local-variables)) | 389 (kill-all-local-variables) |
390 (unless delay-mode-hooks | |
391 (run-hooks 'after-change-major-mode-hook))) | |
74 | 392 |
75 ;; Making and deleting lines. | 393 ;; Making and deleting lines. |
394 | |
395 (defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))) | |
76 | 396 |
77 (defun newline (&optional arg) | 397 (defun newline (&optional arg) |
78 "Insert a newline, and move to left margin of the new line if it's blank. | 398 "Insert a newline, and move to left margin of the new line if it's blank. |
79 If `use-hard-newlines' is non-nil, the newline is marked with the | 399 If `use-hard-newlines' is non-nil, the newline is marked with the |
80 text-property `hard'. | 400 text-property `hard'. |
81 With ARG, insert that many newlines. | 401 With ARG, insert that many newlines. |
82 Call `auto-fill-function' if the current column number is greater | 402 Call `auto-fill-function' if the current column number is greater |
83 than the value of `fill-column' and ARG is `nil'." | 403 than the value of `fill-column' and ARG is nil." |
84 (interactive "*P") | 404 (interactive "*P") |
85 (barf-if-buffer-read-only) | 405 (barf-if-buffer-read-only) |
86 ;; Inserting a newline at the end of a line produces better redisplay in | 406 ;; Inserting a newline at the end of a line produces better redisplay in |
87 ;; try_window_id than inserting at the beginning of a line, and the textual | 407 ;; try_window_id than inserting at the beginning of a line, and the textual |
88 ;; result is the same. So, if we're at beginning of line, pretend to be at | 408 ;; result is the same. So, if we're at beginning of line, pretend to be at |
157 ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list | 477 ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list |
158 (if (and (listp sticky) (not (memq 'hard sticky))) | 478 (if (and (listp sticky) (not (memq 'hard sticky))) |
159 (put-text-property from (point) 'rear-nonsticky | 479 (put-text-property from (point) 'rear-nonsticky |
160 (cons 'hard sticky))))) | 480 (cons 'hard sticky))))) |
161 | 481 |
162 (defun open-line (arg) | 482 (defun open-line (n) |
163 "Insert a newline and leave point before it. | 483 "Insert a newline and leave point before it. |
164 If there is a fill prefix and/or a left-margin, insert them on the new line | 484 If there is a fill prefix and/or a `left-margin', insert them |
165 if the line would have been blank. | 485 on the new line if the line would have been blank. |
166 With arg N, insert N newlines." | 486 With arg N, insert N newlines." |
167 (interactive "*p") | 487 (interactive "*p") |
168 (let* ((do-fill-prefix (and fill-prefix (bolp))) | 488 (let* ((do-fill-prefix (and fill-prefix (bolp))) |
169 (do-left-margin (and (bolp) (> (current-left-margin) 0))) | 489 (do-left-margin (and (bolp) (> (current-left-margin) 0))) |
170 (loc (point)) | 490 (loc (point)) |
171 ;; Don't expand an abbrev before point. | 491 ;; Don't expand an abbrev before point. |
172 (abbrev-mode nil)) | 492 (abbrev-mode nil)) |
173 (newline arg) | 493 (newline n) |
174 (goto-char loc) | 494 (goto-char loc) |
175 (while (> arg 0) | 495 (while (> n 0) |
176 (cond ((bolp) | 496 (cond ((bolp) |
177 (if do-left-margin (indent-to (current-left-margin))) | 497 (if do-left-margin (indent-to (current-left-margin))) |
178 (if do-fill-prefix (insert-and-inherit fill-prefix)))) | 498 (if do-fill-prefix (insert-and-inherit fill-prefix)))) |
179 (forward-line 1) | 499 (forward-line 1) |
180 (setq arg (1- arg))) | 500 (setq n (1- n))) |
181 (goto-char loc) | 501 (goto-char loc) |
182 (end-of-line))) | 502 (end-of-line))) |
183 | 503 |
184 (defun split-line (&optional arg) | 504 (defun split-line (&optional arg) |
185 "Split current line, moving portion beyond point vertically down. | 505 "Split current line, moving portion beyond point vertically down. |
186 If the current line starts with `fill-prefix', insert it on the new | 506 If the current line starts with `fill-prefix', insert it on the new |
187 line as well. With prefix arg, don't insert fill-prefix on new line. | 507 line as well. With prefix ARG, don't insert `fill-prefix' on new line. |
188 | 508 |
189 When called from Lisp code, the arg may be a prefix string to copy." | 509 When called from Lisp code, ARG may be a prefix string to copy." |
190 (interactive "*P") | 510 (interactive "*P") |
191 (skip-chars-forward " \t") | 511 (skip-chars-forward " \t") |
192 (let* ((col (current-column)) | 512 (let* ((col (current-column)) |
193 (pos (point)) | 513 (pos (point)) |
194 ;; What prefix should we check for (nil means don't). | 514 ;; What prefix should we check for (nil means don't). |
301 which means calling the current value of `indent-line-function'. | 621 which means calling the current value of `indent-line-function'. |
302 In programming language modes, this is the same as TAB. | 622 In programming language modes, this is the same as TAB. |
303 In some text modes, where TAB inserts a tab, this indents to the | 623 In some text modes, where TAB inserts a tab, this indents to the |
304 column specified by the function `current-left-margin'." | 624 column specified by the function `current-left-margin'." |
305 (interactive "*") | 625 (interactive "*") |
306 (delete-horizontal-space t) | |
307 (let ((pos (point))) | 626 (let ((pos (point))) |
308 ;; Be careful to insert the newline before indenting the line. | 627 ;; Be careful to insert the newline before indenting the line. |
309 ;; Otherwise, the indentation might be wrong. | 628 ;; Otherwise, the indentation might be wrong. |
310 (newline) | 629 (newline) |
311 (save-excursion | 630 (save-excursion |
312 (goto-char pos) | 631 (goto-char pos) |
313 (indent-according-to-mode)) | 632 (indent-according-to-mode) |
633 (delete-horizontal-space t)) | |
314 (indent-according-to-mode))) | 634 (indent-according-to-mode))) |
315 | 635 |
316 (defun quoted-insert (arg) | 636 (defun quoted-insert (arg) |
317 "Read next input character and insert it. | 637 "Read next input character and insert it. |
318 This is useful for inserting control characters. | 638 This is useful for inserting control characters. |
331 | 651 |
332 In binary overwrite mode, this function does overwrite, and octal | 652 In binary overwrite mode, this function does overwrite, and octal |
333 digits are interpreted as a character code. This is intended to be | 653 digits are interpreted as a character code. This is intended to be |
334 useful for editing binary files." | 654 useful for editing binary files." |
335 (interactive "*p") | 655 (interactive "*p") |
336 (let* ((char (let (translation-table-for-input) | 656 (let* ((char (let (translation-table-for-input input-method-function) |
337 (if (or (not overwrite-mode) | 657 (if (or (not overwrite-mode) |
338 (eq overwrite-mode 'overwrite-mode-binary)) | 658 (eq overwrite-mode 'overwrite-mode-binary)) |
339 (read-quoted-char) | 659 (read-quoted-char) |
340 (read-char))))) | 660 (read-char))))) |
341 ;; Assume character codes 0240 - 0377 stand for characters in some | 661 ;; Assume character codes 0240 - 0377 stand for characters in some |
350 (delete-char arg))) | 670 (delete-char arg))) |
351 (while (> arg 0) | 671 (while (> arg 0) |
352 (insert-and-inherit char) | 672 (insert-and-inherit char) |
353 (setq arg (1- arg))))) | 673 (setq arg (1- arg))))) |
354 | 674 |
355 (defun forward-to-indentation (arg) | 675 (defun forward-to-indentation (&optional arg) |
356 "Move forward ARG lines and position at first nonblank character." | 676 "Move forward ARG lines and position at first nonblank character." |
357 (interactive "p") | 677 (interactive "p") |
358 (forward-line arg) | 678 (forward-line (or arg 1)) |
359 (skip-chars-forward " \t")) | 679 (skip-chars-forward " \t")) |
360 | 680 |
361 (defun backward-to-indentation (arg) | 681 (defun backward-to-indentation (&optional arg) |
362 "Move backward ARG lines and position at first nonblank character." | 682 "Move backward ARG lines and position at first nonblank character." |
363 (interactive "p") | 683 (interactive "p") |
364 (forward-line (- arg)) | 684 (forward-line (- (or arg 1))) |
365 (skip-chars-forward " \t")) | 685 (skip-chars-forward " \t")) |
366 | 686 |
367 (defun back-to-indentation () | 687 (defun back-to-indentation () |
368 "Move point to the first non-whitespace character on this line." | 688 "Move point to the first non-whitespace character on this line." |
369 (interactive) | 689 (interactive) |
370 (beginning-of-line 1) | 690 (beginning-of-line 1) |
371 (let ((limit (line-end-position))) | 691 (skip-syntax-forward " " (line-end-position)) |
372 (skip-syntax-forward " " limit))) | 692 ;; Move back over chars that have whitespace syntax but have the p flag. |
693 (backward-prefix-chars)) | |
373 | 694 |
374 (defun fixup-whitespace () | 695 (defun fixup-whitespace () |
375 "Fixup white space between objects around point. | 696 "Fixup white space between objects around point. |
376 Leave one space or none, according to the context." | 697 Leave one space or none, according to the context." |
377 (interactive "*") | 698 (interactive "*") |
379 (delete-horizontal-space) | 700 (delete-horizontal-space) |
380 (if (or (looking-at "^\\|\\s)") | 701 (if (or (looking-at "^\\|\\s)") |
381 (save-excursion (forward-char -1) | 702 (save-excursion (forward-char -1) |
382 (looking-at "$\\|\\s(\\|\\s'"))) | 703 (looking-at "$\\|\\s(\\|\\s'"))) |
383 nil | 704 nil |
384 (insert ?\ )))) | 705 (insert ?\s)))) |
385 | 706 |
386 (defun delete-horizontal-space (&optional backward-only) | 707 (defun delete-horizontal-space (&optional backward-only) |
387 "Delete all spaces and tabs around point. | 708 "Delete all spaces and tabs around point. |
388 If BACKWARD-ONLY is non-nil, only delete spaces before point." | 709 If BACKWARD-ONLY is non-nil, only delete spaces before point." |
389 (interactive "*") | 710 (interactive "*") |
396 (constrain-to-field nil orig-pos t))) | 717 (constrain-to-field nil orig-pos t))) |
397 (progn | 718 (progn |
398 (skip-chars-backward " \t") | 719 (skip-chars-backward " \t") |
399 (constrain-to-field nil orig-pos))))) | 720 (constrain-to-field nil orig-pos))))) |
400 | 721 |
401 (defun just-one-space () | 722 (defun just-one-space (&optional n) |
402 "Delete all spaces and tabs around point, leaving one space." | 723 "Delete all spaces and tabs around point, leaving one space (or N spaces)." |
403 (interactive "*") | 724 (interactive "*p") |
404 (let ((orig-pos (point))) | 725 (let ((orig-pos (point))) |
405 (skip-chars-backward " \t") | 726 (skip-chars-backward " \t") |
406 (constrain-to-field nil orig-pos) | 727 (constrain-to-field nil orig-pos) |
407 (if (= (following-char) ? ) | 728 (dotimes (i (or n 1)) |
408 (forward-char 1) | 729 (if (= (following-char) ?\s) |
409 (insert ? )) | 730 (forward-char 1) |
731 (insert ?\s))) | |
410 (delete-region | 732 (delete-region |
411 (point) | 733 (point) |
412 (progn | 734 (progn |
413 (skip-chars-forward " \t") | 735 (skip-chars-forward " \t") |
414 (constrain-to-field nil orig-pos t))))) | 736 (constrain-to-field nil orig-pos t))))) |
415 | 737 |
416 (defun beginning-of-buffer (&optional arg) | 738 (defun beginning-of-buffer (&optional arg) |
417 "Move point to the beginning of the buffer; leave mark at previous position. | 739 "Move point to the beginning of the buffer; leave mark at previous position. |
418 With arg N, put point N/10 of the way from the beginning. | 740 With \\[universal-argument] prefix, do not set mark at previous position. |
741 With numeric arg N, put point N/10 of the way from the beginning. | |
419 | 742 |
420 If the buffer is narrowed, this command uses the beginning and size | 743 If the buffer is narrowed, this command uses the beginning and size |
421 of the accessible part of the buffer. | 744 of the accessible part of the buffer. |
422 | 745 |
423 Don't use this command in Lisp programs! | 746 Don't use this command in Lisp programs! |
424 \(goto-char (point-min)) is faster and avoids clobbering the mark." | 747 \(goto-char (point-min)) is faster and avoids clobbering the mark." |
425 (interactive "P") | 748 (interactive "P") |
426 (push-mark) | 749 (or (consp arg) |
750 (and transient-mark-mode mark-active) | |
751 (push-mark)) | |
427 (let ((size (- (point-max) (point-min)))) | 752 (let ((size (- (point-max) (point-min)))) |
428 (goto-char (if arg | 753 (goto-char (if (and arg (not (consp arg))) |
429 (+ (point-min) | 754 (+ (point-min) |
430 (if (> size 10000) | 755 (if (> size 10000) |
431 ;; Avoid overflow for large buffer sizes! | 756 ;; Avoid overflow for large buffer sizes! |
432 (* (prefix-numeric-value arg) | 757 (* (prefix-numeric-value arg) |
433 (/ size 10)) | 758 (/ size 10)) |
435 (point-min)))) | 760 (point-min)))) |
436 (if arg (forward-line 1))) | 761 (if arg (forward-line 1))) |
437 | 762 |
438 (defun end-of-buffer (&optional arg) | 763 (defun end-of-buffer (&optional arg) |
439 "Move point to the end of the buffer; leave mark at previous position. | 764 "Move point to the end of the buffer; leave mark at previous position. |
440 With arg N, put point N/10 of the way from the end. | 765 With \\[universal-argument] prefix, do not set mark at previous position. |
766 With numeric arg N, put point N/10 of the way from the end. | |
441 | 767 |
442 If the buffer is narrowed, this command uses the beginning and size | 768 If the buffer is narrowed, this command uses the beginning and size |
443 of the accessible part of the buffer. | 769 of the accessible part of the buffer. |
444 | 770 |
445 Don't use this command in Lisp programs! | 771 Don't use this command in Lisp programs! |
446 \(goto-char (point-max)) is faster and avoids clobbering the mark." | 772 \(goto-char (point-max)) is faster and avoids clobbering the mark." |
447 (interactive "P") | 773 (interactive "P") |
448 (push-mark) | 774 (or (consp arg) |
775 (and transient-mark-mode mark-active) | |
776 (push-mark)) | |
449 (let ((size (- (point-max) (point-min)))) | 777 (let ((size (- (point-max) (point-min)))) |
450 (goto-char (if arg | 778 (goto-char (if (and arg (not (consp arg))) |
451 (- (point-max) | 779 (- (point-max) |
452 (if (> size 10000) | 780 (if (> size 10000) |
453 ;; Avoid overflow for large buffer sizes! | 781 ;; Avoid overflow for large buffer sizes! |
454 (* (prefix-numeric-value arg) | 782 (* (prefix-numeric-value arg) |
455 (/ size 10)) | 783 (/ size 10)) |
475 (goto-char (point-min))) | 803 (goto-char (point-min))) |
476 | 804 |
477 | 805 |
478 ;; Counting lines, one way or another. | 806 ;; Counting lines, one way or another. |
479 | 807 |
480 (defun goto-line (arg) | 808 (defun goto-line (arg &optional buffer) |
481 "Goto line ARG, counting from line 1 at beginning of buffer." | 809 "Goto line ARG, counting from line 1 at beginning of buffer. |
482 (interactive "NGoto line: ") | 810 Normally, move point in the current buffer. |
483 (setq arg (prefix-numeric-value arg)) | 811 With just \\[universal-argument] as argument, move point in the most recently |
812 displayed other buffer, and switch to it. When called from Lisp code, | |
813 the optional argument BUFFER specifies a buffer to switch to. | |
814 | |
815 If there's a number in the buffer at point, it is the default for ARG." | |
816 (interactive | |
817 (if (and current-prefix-arg (not (consp current-prefix-arg))) | |
818 (list (prefix-numeric-value current-prefix-arg)) | |
819 ;; Look for a default, a number in the buffer at point. | |
820 (let* ((default | |
821 (save-excursion | |
822 (skip-chars-backward "0-9") | |
823 (if (looking-at "[0-9]") | |
824 (buffer-substring-no-properties | |
825 (point) | |
826 (progn (skip-chars-forward "0-9") | |
827 (point)))))) | |
828 ;; Decide if we're switching buffers. | |
829 (buffer | |
830 (if (consp current-prefix-arg) | |
831 (other-buffer (current-buffer) t))) | |
832 (buffer-prompt | |
833 (if buffer | |
834 (concat " in " (buffer-name buffer)) | |
835 ""))) | |
836 ;; Read the argument, offering that number (if any) as default. | |
837 (list (read-from-minibuffer (format (if default "Goto line%s (%s): " | |
838 "Goto line%s: ") | |
839 buffer-prompt | |
840 default) | |
841 nil nil t | |
842 'minibuffer-history | |
843 default) | |
844 buffer)))) | |
845 ;; Switch to the desired buffer, one way or another. | |
846 (if buffer | |
847 (let ((window (get-buffer-window buffer))) | |
848 (if window (select-window window) | |
849 (switch-to-buffer-other-window buffer)))) | |
850 ;; Move to the specified line number in that buffer. | |
484 (save-restriction | 851 (save-restriction |
485 (widen) | 852 (widen) |
486 (goto-char 1) | 853 (goto-char 1) |
487 (if (eq selective-display t) | 854 (if (eq selective-display t) |
488 (re-search-forward "[\n\C-m]" nil 'end (1- arg)) | 855 (re-search-forward "[\n\C-m]" nil 'end (1- arg)) |
495 (count-lines start end) (- end start))) | 862 (count-lines start end) (- end start))) |
496 | 863 |
497 (defun what-line () | 864 (defun what-line () |
498 "Print the current buffer line number and narrowed line number of point." | 865 "Print the current buffer line number and narrowed line number of point." |
499 (interactive) | 866 (interactive) |
500 (let ((opoint (point)) start) | 867 (let ((start (point-min)) |
501 (save-excursion | 868 (n (line-number-at-pos))) |
502 (save-restriction | 869 (if (= start 1) |
503 (goto-char (point-min)) | 870 (message "Line %d" n) |
504 (widen) | 871 (save-excursion |
505 (forward-line 0) | 872 (save-restriction |
506 (setq start (point)) | 873 (widen) |
507 (goto-char opoint) | 874 (message "line %d (narrowed line %d)" |
508 (forward-line 0) | 875 (+ n (line-number-at-pos start) -1) n)))))) |
509 (if (/= start (point-min)) | |
510 (message "line %d (narrowed line %d)" | |
511 (1+ (count-lines (point-min) (point))) | |
512 (1+ (count-lines start (point)))) | |
513 (message "Line %d" (1+ (count-lines (point-min) (point))))))))) | |
514 | 876 |
515 (defun count-lines (start end) | 877 (defun count-lines (start end) |
516 "Return number of lines between START and END. | 878 "Return number of lines between START and END. |
517 This is usually the number of newlines between them, | 879 This is usually the number of newlines between them, |
518 but can be one more if START is not equal to END | 880 but can be one more if START is not equal to END |
533 (not (bolp))) | 895 (not (bolp))) |
534 (1+ done) | 896 (1+ done) |
535 done))) | 897 done))) |
536 (- (buffer-size) (forward-line (buffer-size))))))) | 898 (- (buffer-size) (forward-line (buffer-size))))))) |
537 | 899 |
900 (defun line-number-at-pos (&optional pos) | |
901 "Return (narrowed) buffer line number at position POS. | |
902 If POS is nil, use current buffer location." | |
903 (let ((opoint (or pos (point))) start) | |
904 (save-excursion | |
905 (goto-char (point-min)) | |
906 (setq start (point)) | |
907 (goto-char opoint) | |
908 (forward-line 0) | |
909 (1+ (count-lines start (point)))))) | |
910 | |
538 (defun what-cursor-position (&optional detail) | 911 (defun what-cursor-position (&optional detail) |
539 "Print info on cursor position (on screen and within buffer). | 912 "Print info on cursor position (on screen and within buffer). |
540 Also describe the character after point, and give its character code | 913 Also describe the character after point, and give its character code |
541 in octal, decimal and hex. | 914 in octal, decimal and hex. |
542 | 915 |
562 "" | 935 "" |
563 (format " Hscroll=%d" (window-hscroll)))) | 936 (format " Hscroll=%d" (window-hscroll)))) |
564 (col (current-column))) | 937 (col (current-column))) |
565 (if (= pos end) | 938 (if (= pos end) |
566 (if (or (/= beg 1) (/= end (1+ total))) | 939 (if (or (/= beg 1) (/= end (1+ total))) |
567 (message "point=%d of %d (%d%%) <%d - %d> column %d %s" | 940 (message "point=%d of %d (%d%%) <%d-%d> column=%d%s" |
568 pos total percent beg end col hscroll) | 941 pos total percent beg end col hscroll) |
569 (message "point=%d of %d (%d%%) column %d %s" | 942 (message "point=%d of %d (EOB) column=%d%s" |
570 pos total percent col hscroll)) | 943 pos total col hscroll)) |
571 (let ((coding buffer-file-coding-system) | 944 (let ((coding buffer-file-coding-system) |
572 encoded encoding-msg) | 945 encoded encoding-msg display-prop under-display) |
573 (if (or (not coding) | 946 (if (or (not coding) |
574 (eq (coding-system-type coding) t)) | 947 (eq (coding-system-type coding) t)) |
575 (setq coding default-buffer-file-coding-system)) | 948 (setq coding default-buffer-file-coding-system)) |
576 (if (not (char-valid-p char)) | 949 (if (not (char-valid-p char)) |
577 (setq encoding-msg | 950 (setq encoding-msg |
578 (format "(0%o, %d, 0x%x, invalid)" char char char)) | 951 (format "(%d, #o%o, #x%x, invalid)" char char char)) |
579 (setq encoded (and (>= char 128) (encode-coding-char char coding))) | 952 ;; Check if the character is displayed with some `display' |
953 ;; text property. In that case, set under-display to the | |
954 ;; buffer substring covered by that property. | |
955 (setq display-prop (get-text-property pos 'display)) | |
956 (if display-prop | |
957 (let ((to (or (next-single-property-change pos 'display) | |
958 (point-max)))) | |
959 (if (< to (+ pos 4)) | |
960 (setq under-display "") | |
961 (setq under-display "..." | |
962 to (+ pos 4))) | |
963 (setq under-display | |
964 (concat (buffer-substring-no-properties pos to) | |
965 under-display))) | |
966 (setq encoded (and (>= char 128) (encode-coding-char char coding)))) | |
580 (setq encoding-msg | 967 (setq encoding-msg |
581 (if encoded | 968 (if display-prop |
582 (format "(0%o, %d, 0x%x, file %s)" | 969 (if (not (stringp display-prop)) |
583 char char char | 970 (format "(%d, #o%o, #x%x, part of display \"%s\")" |
584 (if (> (length encoded) 1) | 971 char char char under-display) |
585 "..." | 972 (format "(%d, #o%o, #x%x, part of display \"%s\"->\"%s\")" |
586 (encoded-string-description encoded coding))) | 973 char char char under-display display-prop)) |
587 (format "(0%o, %d, 0x%x)" char char char)))) | 974 (if encoded |
975 (format "(%d, #o%o, #x%x, file %s)" | |
976 char char char | |
977 (if (> (length encoded) 1) | |
978 "..." | |
979 (encoded-string-description encoded coding))) | |
980 (format "(%d, #o%o, #x%x)" char char char))))) | |
588 (if detail | 981 (if detail |
589 ;; We show the detailed information about CHAR. | 982 ;; We show the detailed information about CHAR. |
590 (describe-char (point))) | 983 (describe-char (point))) |
591 (if (or (/= beg 1) (/= end (1+ total))) | 984 (if (or (/= beg 1) (/= end (1+ total))) |
592 (message "Char: %s %s point=%d of %d (%d%%) <%d - %d> column %d %s" | 985 (message "Char: %s %s point=%d of %d (%d%%) <%d-%d> column=%d%s" |
593 (if (< char 256) | 986 (if (< char 256) |
594 (single-key-description char) | 987 (single-key-description char) |
595 (buffer-substring-no-properties (point) (1+ (point)))) | 988 (buffer-substring-no-properties (point) (1+ (point)))) |
596 encoding-msg pos total percent beg end col hscroll) | 989 encoding-msg pos total percent beg end col hscroll) |
597 (message "Char: %s %s point=%d of %d (%d%%) column %d %s" | 990 (message "Char: %s %s point=%d of %d (%d%%) column=%d%s" |
598 (if (< char 256) | 991 (if enable-multibyte-characters |
599 (single-key-description char) | 992 (if (< char 128) |
600 (buffer-substring-no-properties (point) (1+ (point)))) | 993 (single-key-description char) |
994 (buffer-substring-no-properties (point) (1+ (point)))) | |
995 (single-key-description char)) | |
601 encoding-msg pos total percent col hscroll)))))) | 996 encoding-msg pos total percent col hscroll)))))) |
602 | 997 |
603 (defvar read-expression-map | 998 (defvar read-expression-map |
604 (let ((m (make-sparse-keymap))) | 999 (let ((m (make-sparse-keymap))) |
605 (define-key m "\M-\t" 'lisp-complete-symbol) | 1000 (define-key m "\M-\t" 'lisp-complete-symbol) |
608 "Minibuffer keymap used for reading Lisp expressions.") | 1003 "Minibuffer keymap used for reading Lisp expressions.") |
609 | 1004 |
610 (defvar read-expression-history nil) | 1005 (defvar read-expression-history nil) |
611 | 1006 |
612 (defcustom eval-expression-print-level 4 | 1007 (defcustom eval-expression-print-level 4 |
613 "*Value to use for `print-level' when printing value in `eval-expression'. | 1008 "Value for `print-level' while printing value in `eval-expression'. |
614 A value of nil means no limit." | 1009 A value of nil means no limit." |
615 :group 'lisp | 1010 :group 'lisp |
616 :type '(choice (const :tag "No Limit" nil) integer) | 1011 :type '(choice (const :tag "No Limit" nil) integer) |
617 :version "21.1") | 1012 :version "21.1") |
618 | 1013 |
619 (defcustom eval-expression-print-length 12 | 1014 (defcustom eval-expression-print-length 12 |
620 "*Value to use for `print-length' when printing value in `eval-expression'. | 1015 "Value for `print-length' while printing value in `eval-expression'. |
621 A value of nil means no limit." | 1016 A value of nil means no limit." |
622 :group 'lisp | 1017 :group 'lisp |
623 :type '(choice (const :tag "No Limit" nil) integer) | 1018 :type '(choice (const :tag "No Limit" nil) integer) |
624 :version "21.1") | 1019 :version "21.1") |
625 | 1020 |
626 (defcustom eval-expression-debug-on-error t | 1021 (defcustom eval-expression-debug-on-error t |
627 "*Non-nil means set `debug-on-error' when evaluating in `eval-expression'. | 1022 "If non-nil set `debug-on-error' to t in `eval-expression'. |
628 If nil, don't change the value of `debug-on-error'." | 1023 If nil, don't change the value of `debug-on-error'." |
629 :group 'lisp | 1024 :group 'lisp |
630 :type 'boolean | 1025 :type 'boolean |
631 :version "21.1") | 1026 :version "21.1") |
1027 | |
1028 (defun eval-expression-print-format (value) | |
1029 "Format VALUE as a result of evaluated expression. | |
1030 Return a formatted string which is displayed in the echo area | |
1031 in addition to the value printed by prin1 in functions which | |
1032 display the result of expression evaluation." | |
1033 (if (and (integerp value) | |
1034 (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp))) | |
1035 (eq this-command last-command) | |
1036 (if (boundp 'edebug-active) edebug-active))) | |
1037 (let ((char-string | |
1038 (if (or (if (boundp 'edebug-active) edebug-active) | |
1039 (memq this-command '(eval-last-sexp eval-print-last-sexp))) | |
1040 (prin1-char value)))) | |
1041 (if char-string | |
1042 (format " (#o%o, #x%x, %s)" value value char-string) | |
1043 (format " (#o%o, #x%x)" value value))))) | |
632 | 1044 |
633 ;; We define this, rather than making `eval' interactive, | 1045 ;; We define this, rather than making `eval' interactive, |
634 ;; for the sake of completion of names like eval-region, eval-current-buffer. | 1046 ;; for the sake of completion of names like eval-region, eval-current-buffer. |
635 (defun eval-expression (eval-expression-arg | 1047 (defun eval-expression (eval-expression-arg |
636 &optional eval-expression-insert-value) | 1048 &optional eval-expression-insert-value) |
658 (unless (eq old-value new-value) | 1070 (unless (eq old-value new-value) |
659 (setq debug-on-error new-value)))) | 1071 (setq debug-on-error new-value)))) |
660 | 1072 |
661 (let ((print-length eval-expression-print-length) | 1073 (let ((print-length eval-expression-print-length) |
662 (print-level eval-expression-print-level)) | 1074 (print-level eval-expression-print-level)) |
663 (prin1 (car values) | 1075 (if eval-expression-insert-value |
664 (if eval-expression-insert-value (current-buffer) t)))) | 1076 (with-no-warnings |
1077 (let ((standard-output (current-buffer))) | |
1078 (eval-last-sexp-print-value (car values)))) | |
1079 (prog1 | |
1080 (prin1 (car values) t) | |
1081 (let ((str (eval-expression-print-format (car values)))) | |
1082 (if str (princ str t))))))) | |
665 | 1083 |
666 (defun edit-and-eval-command (prompt command) | 1084 (defun edit-and-eval-command (prompt command) |
667 "Prompting with PROMPT, let user edit COMMAND and eval result. | 1085 "Prompting with PROMPT, let user edit COMMAND and eval result. |
668 COMMAND is a Lisp expression. Let user edit that expression in | 1086 COMMAND is a Lisp expression. Let user edit that expression in |
669 the minibuffer, then read and evaluate the result." | 1087 the minibuffer, then read and evaluate the result." |
670 (let ((command | 1088 (let ((command |
671 (unwind-protect | 1089 (let ((print-level nil) |
672 (read-from-minibuffer prompt | 1090 (minibuffer-history-sexp-flag (1+ (minibuffer-depth)))) |
673 (prin1-to-string command) | 1091 (unwind-protect |
674 read-expression-map t | 1092 (read-from-minibuffer prompt |
675 '(command-history . 1)) | 1093 (prin1-to-string command) |
676 ;; If command was added to command-history as a string, | 1094 read-expression-map t |
677 ;; get rid of that. We want only evaluable expressions there. | 1095 'command-history) |
678 (if (stringp (car command-history)) | 1096 ;; If command was added to command-history as a string, |
679 (setq command-history (cdr command-history)))))) | 1097 ;; get rid of that. We want only evaluable expressions there. |
1098 (if (stringp (car command-history)) | |
1099 (setq command-history (cdr command-history))))))) | |
680 | 1100 |
681 ;; If command to be redone does not match front of history, | 1101 ;; If command to be redone does not match front of history, |
682 ;; add it to the history. | 1102 ;; add it to the history. |
683 (or (equal command (car command-history)) | 1103 (or (equal command (car command-history)) |
684 (setq command-history (cons command command-history))) | 1104 (setq command-history (cons command command-history))) |
725 (defvar minibuffer-history nil | 1145 (defvar minibuffer-history nil |
726 "Default minibuffer history list. | 1146 "Default minibuffer history list. |
727 This is used for all minibuffer input | 1147 This is used for all minibuffer input |
728 except when an alternate history list is specified.") | 1148 except when an alternate history list is specified.") |
729 (defvar minibuffer-history-sexp-flag nil | 1149 (defvar minibuffer-history-sexp-flag nil |
730 "Non-nil when doing history operations on the variable `command-history'. | 1150 "Control whether history list elements are expressions or strings. |
731 More generally, indicates that the history list being acted on | 1151 If the value of this variable equals current minibuffer depth, |
732 contains expressions rather than strings. | 1152 they are expressions; otherwise they are strings. |
733 It is only valid if its value equals the current minibuffer depth, | 1153 \(That convention is designed to do the right thing for |
734 to handle recursive uses of the minibuffer.") | 1154 recursive uses of the minibuffer.)") |
735 (setq minibuffer-history-variable 'minibuffer-history) | 1155 (setq minibuffer-history-variable 'minibuffer-history) |
736 (setq minibuffer-history-position nil) | 1156 (setq minibuffer-history-position nil) |
737 (defvar minibuffer-history-search-history nil) | 1157 (defvar minibuffer-history-search-history nil) |
738 | 1158 |
739 (defvar minibuffer-text-before-history nil | 1159 (defvar minibuffer-text-before-history nil |
771 (let* ((enable-recursive-minibuffers t) | 1191 (let* ((enable-recursive-minibuffers t) |
772 (regexp (read-from-minibuffer "Previous element matching (regexp): " | 1192 (regexp (read-from-minibuffer "Previous element matching (regexp): " |
773 nil | 1193 nil |
774 minibuffer-local-map | 1194 minibuffer-local-map |
775 nil | 1195 nil |
776 'minibuffer-history-search-history))) | 1196 'minibuffer-history-search-history |
1197 (car minibuffer-history-search-history)))) | |
777 ;; Use the last regexp specified, by default, if input is empty. | 1198 ;; Use the last regexp specified, by default, if input is empty. |
778 (list (if (string= regexp "") | 1199 (list (if (string= regexp "") |
779 (if minibuffer-history-search-history | 1200 (if minibuffer-history-search-history |
780 (car minibuffer-history-search-history) | 1201 (car minibuffer-history-search-history) |
781 (error "No previous history search regexp")) | 1202 (error "No previous history search regexp")) |
841 (let* ((enable-recursive-minibuffers t) | 1262 (let* ((enable-recursive-minibuffers t) |
842 (regexp (read-from-minibuffer "Next element matching (regexp): " | 1263 (regexp (read-from-minibuffer "Next element matching (regexp): " |
843 nil | 1264 nil |
844 minibuffer-local-map | 1265 minibuffer-local-map |
845 nil | 1266 nil |
846 'minibuffer-history-search-history))) | 1267 'minibuffer-history-search-history |
1268 (car minibuffer-history-search-history)))) | |
847 ;; Use the last regexp specified, by default, if input is empty. | 1269 ;; Use the last regexp specified, by default, if input is empty. |
848 (list (if (string= regexp "") | 1270 (list (if (string= regexp "") |
849 (setcar minibuffer-history-search-history | 1271 (if minibuffer-history-search-history |
850 (nth 1 minibuffer-history-search-history)) | 1272 (car minibuffer-history-search-history) |
1273 (error "No previous history search regexp")) | |
851 regexp) | 1274 regexp) |
852 (prefix-numeric-value current-prefix-arg)))) | 1275 (prefix-numeric-value current-prefix-arg)))) |
853 (previous-matching-history-element regexp (- n))) | 1276 (previous-matching-history-element regexp (- n))) |
854 | 1277 |
855 (defvar minibuffer-temporary-goal-position nil) | 1278 (defvar minibuffer-temporary-goal-position nil) |
926 (next-complete-history-element (- n))) | 1349 (next-complete-history-element (- n))) |
927 | 1350 |
928 ;; For compatibility with the old subr of the same name. | 1351 ;; For compatibility with the old subr of the same name. |
929 (defun minibuffer-prompt-width () | 1352 (defun minibuffer-prompt-width () |
930 "Return the display width of the minibuffer prompt. | 1353 "Return the display width of the minibuffer prompt. |
931 Return 0 if current buffer is not a mini-buffer." | 1354 Return 0 if current buffer is not a minibuffer." |
932 ;; Return the width of everything before the field at the end of | 1355 ;; Return the width of everything before the field at the end of |
933 ;; the buffer; this should be 0 for normal buffers. | 1356 ;; the buffer; this should be 0 for normal buffers. |
934 (1- (minibuffer-prompt-end))) | 1357 (1- (minibuffer-prompt-end))) |
935 | 1358 |
936 ;Put this on C-x u, so we can force that rather than C-_ into startup msg | 1359 ;Put this on C-x u, so we can force that rather than C-_ into startup msg |
937 (defalias 'advertised-undo 'undo) | 1360 (defalias 'advertised-undo 'undo) |
938 | 1361 |
1362 (defconst undo-equiv-table (make-hash-table :test 'eq :weakness t) | |
1363 "Table mapping redo records to the corresponding undo one. | |
1364 A redo record for undo-in-region maps to t. | |
1365 A redo record for ordinary undo maps to the following (earlier) undo.") | |
1366 | |
1367 (defvar undo-in-region nil | |
1368 "Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.") | |
1369 | |
1370 (defvar undo-no-redo nil | |
1371 "If t, `undo' doesn't go through redo entries.") | |
1372 | |
1373 (defvar pending-undo-list nil | |
1374 "Within a run of consecutive undo commands, list remaining to be undone. | |
1375 If t, we undid all the way to the end of it.") | |
1376 | |
939 (defun undo (&optional arg) | 1377 (defun undo (&optional arg) |
940 "Undo some previous changes. | 1378 "Undo some previous changes. |
941 Repeat this command to undo more changes. | 1379 Repeat this command to undo more changes. |
942 A numeric argument serves as a repeat count. | 1380 A numeric argument serves as a repeat count. |
943 | 1381 |
944 In Transient Mark mode when the mark is active, only undo changes within | 1382 In Transient Mark mode when the mark is active, only undo changes within |
945 the current region. Similarly, when not in Transient Mark mode, just C-u | 1383 the current region. Similarly, when not in Transient Mark mode, just \\[universal-argument] |
946 as an argument limits undo to changes within the current region." | 1384 as an argument limits undo to changes within the current region." |
947 (interactive "*P") | 1385 (interactive "*P") |
948 ;; Make last-command indicate for the next command that this was an undo. | 1386 ;; Make last-command indicate for the next command that this was an undo. |
949 ;; That way, another undo will undo more. | 1387 ;; That way, another undo will undo more. |
950 ;; If we get to the end of the undo history and get an error, | 1388 ;; If we get to the end of the undo history and get an error, |
951 ;; another undo command will find the undo history empty | 1389 ;; another undo command will find the undo history empty |
952 ;; and will get another error. To begin undoing the undos, | 1390 ;; and will get another error. To begin undoing the undos, |
953 ;; you must type some other command. | 1391 ;; you must type some other command. |
954 (setq this-command 'undo) | |
955 (let ((modified (buffer-modified-p)) | 1392 (let ((modified (buffer-modified-p)) |
956 (recent-save (recent-auto-save-p))) | 1393 (recent-save (recent-auto-save-p)) |
957 (or (eq (selected-window) (minibuffer-window)) | 1394 message) |
958 (message (if (and transient-mark-mode mark-active) | 1395 ;; If we get an error in undo-start, |
959 "Undo in region!" | 1396 ;; the next command should not be a "consecutive undo". |
960 "Undo!"))) | 1397 ;; So set `this-command' to something other than `undo'. |
961 (unless (eq last-command 'undo) | 1398 (setq this-command 'undo-start) |
962 (if (if transient-mark-mode mark-active (and arg (not (numberp arg)))) | 1399 |
1400 (unless (and (eq last-command 'undo) | |
1401 (or (eq pending-undo-list t) | |
1402 ;; If something (a timer or filter?) changed the buffer | |
1403 ;; since the previous command, don't continue the undo seq. | |
1404 (let ((list buffer-undo-list)) | |
1405 (while (eq (car list) nil) | |
1406 (setq list (cdr list))) | |
1407 ;; If the last undo record made was made by undo | |
1408 ;; it shows nothing else happened in between. | |
1409 (gethash list undo-equiv-table)))) | |
1410 (setq undo-in-region | |
1411 (if transient-mark-mode mark-active (and arg (not (numberp arg))))) | |
1412 (if undo-in-region | |
963 (undo-start (region-beginning) (region-end)) | 1413 (undo-start (region-beginning) (region-end)) |
964 (undo-start)) | 1414 (undo-start)) |
965 ;; get rid of initial undo boundary | 1415 ;; get rid of initial undo boundary |
966 (undo-more 1)) | 1416 (undo-more 1)) |
1417 ;; If we got this far, the next command should be a consecutive undo. | |
1418 (setq this-command 'undo) | |
1419 ;; Check to see whether we're hitting a redo record, and if | |
1420 ;; so, ask the user whether she wants to skip the redo/undo pair. | |
1421 (let ((equiv (gethash pending-undo-list undo-equiv-table))) | |
1422 (or (eq (selected-window) (minibuffer-window)) | |
1423 (setq message (if undo-in-region | |
1424 (if equiv "Redo in region!" "Undo in region!") | |
1425 (if equiv "Redo!" "Undo!")))) | |
1426 (when (and (consp equiv) undo-no-redo) | |
1427 ;; The equiv entry might point to another redo record if we have done | |
1428 ;; undo-redo-undo-redo-... so skip to the very last equiv. | |
1429 (while (let ((next (gethash equiv undo-equiv-table))) | |
1430 (if next (setq equiv next)))) | |
1431 (setq pending-undo-list equiv))) | |
967 (undo-more | 1432 (undo-more |
968 (if (or transient-mark-mode (numberp arg)) | 1433 (if (or transient-mark-mode (numberp arg)) |
969 (prefix-numeric-value arg) | 1434 (prefix-numeric-value arg) |
970 1)) | 1435 1)) |
1436 ;; Record the fact that the just-generated undo records come from an | |
1437 ;; undo operation--that is, they are redo records. | |
1438 ;; In the ordinary case (not within a region), map the redo | |
1439 ;; record to the following undos. | |
1440 ;; I don't know how to do that in the undo-in-region case. | |
1441 (puthash buffer-undo-list | |
1442 (if undo-in-region t pending-undo-list) | |
1443 undo-equiv-table) | |
971 ;; Don't specify a position in the undo record for the undo command. | 1444 ;; Don't specify a position in the undo record for the undo command. |
972 ;; Instead, undoing this should move point to where the change is. | 1445 ;; Instead, undoing this should move point to where the change is. |
973 (let ((tail buffer-undo-list) | 1446 (let ((tail buffer-undo-list) |
974 (prev nil)) | 1447 (prev nil)) |
975 (while (car tail) | 1448 (while (car tail) |
976 (when (integerp (car tail)) | 1449 (when (integerp (car tail)) |
977 (let ((pos (car tail))) | 1450 (let ((pos (car tail))) |
978 (if (null prev) | 1451 (if prev |
979 (setq buffer-undo-list (cdr tail)) | 1452 (setcdr prev (cdr tail)) |
980 (setcdr prev (cdr tail))) | 1453 (setq buffer-undo-list (cdr tail))) |
981 (setq tail (cdr tail)) | 1454 (setq tail (cdr tail)) |
982 (while (car tail) | 1455 (while (car tail) |
983 (if (eq pos (car tail)) | 1456 (if (eq pos (car tail)) |
984 (if prev | 1457 (if prev |
985 (setcdr prev (cdr tail)) | 1458 (setcdr prev (cdr tail)) |
986 (setq buffer-undo-list (cdr tail))) | 1459 (setq buffer-undo-list (cdr tail))) |
987 (setq prev tail)) | 1460 (setq prev tail)) |
988 (setq tail (cdr tail))) | 1461 (setq tail (cdr tail))) |
989 (setq tail nil))) | 1462 (setq tail nil))) |
990 (setq prev tail tail (cdr tail)))) | 1463 (setq prev tail tail (cdr tail)))) |
991 | 1464 ;; Record what the current undo list says, |
1465 ;; so the next command can tell if the buffer was modified in between. | |
992 (and modified (not (buffer-modified-p)) | 1466 (and modified (not (buffer-modified-p)) |
993 (delete-auto-save-file-if-necessary recent-save)))) | 1467 (delete-auto-save-file-if-necessary recent-save)) |
994 | 1468 ;; Display a message announcing success. |
995 (defvar pending-undo-list nil | 1469 (if message |
996 "Within a run of consecutive undo commands, list remaining to be undone.") | 1470 (message message)))) |
1471 | |
1472 (defun buffer-disable-undo (&optional buffer) | |
1473 "Make BUFFER stop keeping undo information. | |
1474 No argument or nil as argument means do this for the current buffer." | |
1475 (interactive) | |
1476 (with-current-buffer (if buffer (get-buffer buffer) (current-buffer)) | |
1477 (setq buffer-undo-list t))) | |
1478 | |
1479 (defun undo-only (&optional arg) | |
1480 "Undo some previous changes. | |
1481 Repeat this command to undo more changes. | |
1482 A numeric argument serves as a repeat count. | |
1483 Contrary to `undo', this will not redo a previous undo." | |
1484 (interactive "*p") | |
1485 (let ((undo-no-redo t)) (undo arg))) | |
997 | 1486 |
998 (defvar undo-in-progress nil | 1487 (defvar undo-in-progress nil |
999 "Non-nil while performing an undo. | 1488 "Non-nil while performing an undo. |
1000 Some change-hooks test this variable to do something different.") | 1489 Some change-hooks test this variable to do something different.") |
1001 | 1490 |
1002 (defun undo-more (count) | 1491 (defun undo-more (n) |
1003 "Undo back N undo-boundaries beyond what was already undone recently. | 1492 "Undo back N undo-boundaries beyond what was already undone recently. |
1004 Call `undo-start' to get ready to undo recent changes, | 1493 Call `undo-start' to get ready to undo recent changes, |
1005 then call `undo-more' one or more times to undo them." | 1494 then call `undo-more' one or more times to undo them." |
1006 (or pending-undo-list | 1495 (or (listp pending-undo-list) |
1007 (error (format "No further undo information%s" | 1496 (error (concat "No further undo information" |
1008 (if (and transient-mark-mode mark-active) | 1497 (and transient-mark-mode mark-active |
1009 " for region" "")))) | 1498 " for region")))) |
1010 (let ((undo-in-progress t)) | 1499 (let ((undo-in-progress t)) |
1011 (setq pending-undo-list (primitive-undo count pending-undo-list)))) | 1500 (setq pending-undo-list (primitive-undo n pending-undo-list)) |
1501 (if (null pending-undo-list) | |
1502 (setq pending-undo-list t)))) | |
1012 | 1503 |
1013 ;; Deep copy of a list | 1504 ;; Deep copy of a list |
1014 (defun undo-copy-list (list) | 1505 (defun undo-copy-list (list) |
1015 "Make a copy of undo list LIST." | 1506 "Make a copy of undo list LIST." |
1016 (mapcar 'undo-copy-list-1 list)) | 1507 (mapcar 'undo-copy-list-1 list)) |
1170 ;; (BEGIN . END) | 1661 ;; (BEGIN . END) |
1171 (cons (car undo-elt) (- (car undo-elt) (cdr undo-elt)))) | 1662 (cons (car undo-elt) (- (car undo-elt) (cdr undo-elt)))) |
1172 (t | 1663 (t |
1173 '(0 . 0))) | 1664 '(0 . 0))) |
1174 '(0 . 0))) | 1665 '(0 . 0))) |
1666 | |
1667 (defcustom undo-ask-before-discard t | |
1668 "If non-nil ask about discarding undo info for the current command. | |
1669 Normally, Emacs discards the undo info for the current command if | |
1670 it exceeds `undo-outer-limit'. But if you set this option | |
1671 non-nil, it asks in the echo area whether to discard the info. | |
1672 If you answer no, there a slight risk that Emacs might crash, so | |
1673 only do it if you really want to undo the command. | |
1674 | |
1675 This option is mainly intended for debugging. You have to be | |
1676 careful if you use it for other purposes. Garbage collection is | |
1677 inhibited while the question is asked, meaning that Emacs might | |
1678 leak memory. So you should make sure that you do not wait | |
1679 excessively long before answering the question." | |
1680 :type 'boolean | |
1681 :group 'undo | |
1682 :version "22.1") | |
1683 | |
1684 (defvar undo-extra-outer-limit nil | |
1685 "If non-nil, an extra level of size that's ok in an undo item. | |
1686 We don't ask the user about truncating the undo list until the | |
1687 current item gets bigger than this amount. | |
1688 | |
1689 This variable only matters if `undo-ask-before-discard' is non-nil.") | |
1690 (make-variable-buffer-local 'undo-extra-outer-limit) | |
1691 | |
1692 ;; When the first undo batch in an undo list is longer than | |
1693 ;; undo-outer-limit, this function gets called to warn the user that | |
1694 ;; the undo info for the current command was discarded. Garbage | |
1695 ;; collection is inhibited around the call, so it had better not do a | |
1696 ;; lot of consing. | |
1697 (setq undo-outer-limit-function 'undo-outer-limit-truncate) | |
1698 (defun undo-outer-limit-truncate (size) | |
1699 (if undo-ask-before-discard | |
1700 (when (or (null undo-extra-outer-limit) | |
1701 (> size undo-extra-outer-limit)) | |
1702 ;; Don't ask the question again unless it gets even bigger. | |
1703 ;; This applies, in particular, if the user quits from the question. | |
1704 ;; Such a quit quits out of GC, but something else will call GC | |
1705 ;; again momentarily. It will call this function again, | |
1706 ;; but we don't want to ask the question again. | |
1707 (setq undo-extra-outer-limit (+ size 50000)) | |
1708 (if (let (use-dialog-box track-mouse executing-kbd-macro ) | |
1709 (yes-or-no-p (format "Buffer %s undo info is %d bytes long; discard it? " | |
1710 (buffer-name) size))) | |
1711 (progn (setq buffer-undo-list nil) | |
1712 (setq undo-extra-outer-limit nil) | |
1713 t) | |
1714 nil)) | |
1715 (display-warning '(undo discard-info) | |
1716 (concat | |
1717 (format "Buffer %s undo info was %d bytes long.\n" | |
1718 (buffer-name) size) | |
1719 "The undo info was discarded because it exceeded \ | |
1720 `undo-outer-limit'. | |
1721 | |
1722 This is normal if you executed a command that made a huge change | |
1723 to the buffer. In that case, to prevent similar problems in the | |
1724 future, set `undo-outer-limit' to a value that is large enough to | |
1725 cover the maximum size of normal changes you expect a single | |
1726 command to make, but not so large that it might exceed the | |
1727 maximum memory allotted to Emacs. | |
1728 | |
1729 If you did not execute any such command, the situation is | |
1730 probably due to a bug and you should report it. | |
1731 | |
1732 You can disable the popping up of this buffer by adding the entry | |
1733 \(undo discard-info) to the user option `warning-suppress-types'.\n") | |
1734 :warning) | |
1735 (setq buffer-undo-list nil) | |
1736 t)) | |
1175 | 1737 |
1176 (defvar shell-command-history nil | 1738 (defvar shell-command-history nil |
1177 "History list for some commands that read shell commands.") | 1739 "History list for some commands that read shell commands.") |
1178 | 1740 |
1179 (defvar shell-command-switch "-c" | 1741 (defvar shell-command-switch "-c" |
1303 (setq proc (get-buffer-process buffer)) | 1865 (setq proc (get-buffer-process buffer)) |
1304 (if proc | 1866 (if proc |
1305 (if (yes-or-no-p "A command is running. Kill it? ") | 1867 (if (yes-or-no-p "A command is running. Kill it? ") |
1306 (kill-process proc) | 1868 (kill-process proc) |
1307 (error "Shell command in progress"))) | 1869 (error "Shell command in progress"))) |
1308 (save-excursion | 1870 (with-current-buffer buffer |
1309 (set-buffer buffer) | |
1310 (setq buffer-read-only nil) | 1871 (setq buffer-read-only nil) |
1311 (erase-buffer) | 1872 (erase-buffer) |
1312 (display-buffer buffer) | 1873 (display-buffer buffer) |
1313 (setq default-directory directory) | 1874 (setq default-directory directory) |
1314 (setq proc (start-process "Shell" buffer shell-file-name | 1875 (setq proc (start-process "Shell" buffer shell-file-name |
1397 (car (cdr (cdr (process-command process)))) | 1958 (car (cdr (cdr (process-command process)))) |
1398 (substring signal 0 -1)))) | 1959 (substring signal 0 -1)))) |
1399 | 1960 |
1400 (defun shell-command-on-region (start end command | 1961 (defun shell-command-on-region (start end command |
1401 &optional output-buffer replace | 1962 &optional output-buffer replace |
1402 error-buffer) | 1963 error-buffer display-error-buffer) |
1403 "Execute string COMMAND in inferior shell with region as input. | 1964 "Execute string COMMAND in inferior shell with region as input. |
1404 Normally display output (if any) in temp buffer `*Shell Command Output*'; | 1965 Normally display output (if any) in temp buffer `*Shell Command Output*'; |
1405 Prefix arg means replace the region with it. Return the exit code of | 1966 Prefix arg means replace the region with it. Return the exit code of |
1406 COMMAND. | 1967 COMMAND. |
1407 | 1968 |
1410 before this command. By default, the input (from the current buffer) | 1971 before this command. By default, the input (from the current buffer) |
1411 is encoded in the same coding system that will be used to save the file, | 1972 is encoded in the same coding system that will be used to save the file, |
1412 `buffer-file-coding-system'. If the output is going to replace the region, | 1973 `buffer-file-coding-system'. If the output is going to replace the region, |
1413 then it is decoded from that same coding system. | 1974 then it is decoded from that same coding system. |
1414 | 1975 |
1415 The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, | 1976 The noninteractive arguments are START, END, COMMAND, |
1416 REPLACE, ERROR-BUFFER. Noninteractive callers can specify coding | 1977 OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER. |
1417 systems by binding `coding-system-for-read' and | 1978 Noninteractive callers can specify coding systems by binding |
1418 `coding-system-for-write'. | 1979 `coding-system-for-read' and `coding-system-for-write'. |
1419 | 1980 |
1420 If the command generates output, the output may be displayed | 1981 If the command generates output, the output may be displayed |
1421 in the echo area or in a buffer. | 1982 in the echo area or in a buffer. |
1422 If the output is short enough to display in the echo area | 1983 If the output is short enough to display in the echo area |
1423 \(determined by the variable `max-mini-window-height' if | 1984 \(determined by the variable `max-mini-window-height' if |
1443 around it. | 2004 around it. |
1444 | 2005 |
1445 If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer | 2006 If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer |
1446 or buffer name to which to direct the command's standard error output. | 2007 or buffer name to which to direct the command's standard error output. |
1447 If it is nil, error output is mingled with regular output. | 2008 If it is nil, error output is mingled with regular output. |
2009 If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there | |
2010 were any errors. (This is always t, interactively.) | |
1448 In an interactive call, the variable `shell-command-default-error-buffer' | 2011 In an interactive call, the variable `shell-command-default-error-buffer' |
1449 specifies the value of ERROR-BUFFER." | 2012 specifies the value of ERROR-BUFFER." |
1450 (interactive (let (string) | 2013 (interactive (let (string) |
1451 (unless (mark) | 2014 (unless (mark) |
1452 (error "The mark is not set now, so there is no region")) | 2015 (error "The mark is not set now, so there is no region")) |
1460 ;; region-end specially, leaving them in the history. | 2023 ;; region-end specially, leaving them in the history. |
1461 (list (region-beginning) (region-end) | 2024 (list (region-beginning) (region-end) |
1462 string | 2025 string |
1463 current-prefix-arg | 2026 current-prefix-arg |
1464 current-prefix-arg | 2027 current-prefix-arg |
1465 shell-command-default-error-buffer))) | 2028 shell-command-default-error-buffer |
2029 t))) | |
1466 (let ((error-file | 2030 (let ((error-file |
1467 (if error-buffer | 2031 (if error-buffer |
1468 (make-temp-file | 2032 (make-temp-file |
1469 (expand-file-name "scor" | 2033 (expand-file-name "scor" |
1470 (or small-temporary-file-directory | 2034 (or small-temporary-file-directory |
1569 ;; because that can run a shell command, and we | 2133 ;; because that can run a shell command, and we |
1570 ;; don't want that to cause an infinite recursion. | 2134 ;; don't want that to cause an infinite recursion. |
1571 (format-insert-file error-file nil) | 2135 (format-insert-file error-file nil) |
1572 ;; Put point after the inserted errors. | 2136 ;; Put point after the inserted errors. |
1573 (goto-char (- (point-max) pos-from-end))) | 2137 (goto-char (- (point-max) pos-from-end))) |
1574 (display-buffer (current-buffer)))) | 2138 (and display-error-buffer |
2139 (display-buffer (current-buffer))))) | |
1575 (delete-file error-file)) | 2140 (delete-file error-file)) |
1576 exit-status)) | 2141 exit-status)) |
1577 | 2142 |
1578 (defun shell-command-to-string (command) | 2143 (defun shell-command-to-string (command) |
1579 "Execute shell command COMMAND and return its output as a string." | 2144 "Execute shell command COMMAND and return its output as a string." |
1580 (with-output-to-string | 2145 (with-output-to-string |
1581 (with-current-buffer | 2146 (with-current-buffer |
1582 standard-output | 2147 standard-output |
1583 (call-process shell-file-name nil t nil shell-command-switch command)))) | 2148 (call-process shell-file-name nil t nil shell-command-switch command)))) |
2149 | |
2150 (defun process-file (program &optional infile buffer display &rest args) | |
2151 "Process files synchronously in a separate process. | |
2152 Similar to `call-process', but may invoke a file handler based on | |
2153 `default-directory'. The current working directory of the | |
2154 subprocess is `default-directory'. | |
2155 | |
2156 File names in INFILE and BUFFER are handled normally, but file | |
2157 names in ARGS should be relative to `default-directory', as they | |
2158 are passed to the process verbatim. \(This is a difference to | |
2159 `call-process' which does not support file handlers for INFILE | |
2160 and BUFFER.\) | |
2161 | |
2162 Some file handlers might not support all variants, for example | |
2163 they might behave as if DISPLAY was nil, regardless of the actual | |
2164 value passed." | |
2165 (let ((fh (find-file-name-handler default-directory 'process-file)) | |
2166 lc stderr-file) | |
2167 (unwind-protect | |
2168 (if fh (apply fh 'process-file program infile buffer display args) | |
2169 (when infile (setq lc (file-local-copy infile))) | |
2170 (setq stderr-file (when (and (consp buffer) (stringp (cadr buffer))) | |
2171 (make-temp-file "emacs"))) | |
2172 (prog1 | |
2173 (apply 'call-process program | |
2174 (or lc infile) | |
2175 (if stderr-file (list (car buffer) stderr-file) buffer) | |
2176 display args) | |
2177 (when stderr-file (copy-file stderr-file (cadr buffer))))) | |
2178 (when stderr-file (delete-file stderr-file)) | |
2179 (when lc (delete-file lc))))) | |
2180 | |
2181 | |
1584 | 2182 |
1585 (defvar universal-argument-map | 2183 (defvar universal-argument-map |
1586 (let ((map (make-sparse-keymap))) | 2184 (let ((map (make-sparse-keymap))) |
1587 (define-key map [t] 'universal-argument-other-key) | 2185 (define-key map [t] 'universal-argument-other-key) |
1588 (define-key map (vector meta-prefix-char t) 'universal-argument-other-key) | 2186 (define-key map (vector meta-prefix-char t) 'universal-argument-other-key) |
1616 (defvar universal-argument-num-events nil | 2214 (defvar universal-argument-num-events nil |
1617 "Number of argument-specifying events read by `universal-argument'. | 2215 "Number of argument-specifying events read by `universal-argument'. |
1618 `universal-argument-other-key' uses this to discard those events | 2216 `universal-argument-other-key' uses this to discard those events |
1619 from (this-command-keys), and reread only the final command.") | 2217 from (this-command-keys), and reread only the final command.") |
1620 | 2218 |
2219 (defvar overriding-map-is-bound nil | |
2220 "Non-nil when `overriding-terminal-local-map' is `universal-argument-map'.") | |
2221 | |
2222 (defvar saved-overriding-map nil | |
2223 "The saved value of `overriding-terminal-local-map'. | |
2224 That variable gets restored to this value on exiting \"universal | |
2225 argument mode\".") | |
2226 | |
2227 (defun ensure-overriding-map-is-bound () | |
2228 "Check `overriding-terminal-local-map' is `universal-argument-map'." | |
2229 (unless overriding-map-is-bound | |
2230 (setq saved-overriding-map overriding-terminal-local-map) | |
2231 (setq overriding-terminal-local-map universal-argument-map) | |
2232 (setq overriding-map-is-bound t))) | |
2233 | |
2234 (defun restore-overriding-map () | |
2235 "Restore `overriding-terminal-local-map' to its saved value." | |
2236 (setq overriding-terminal-local-map saved-overriding-map) | |
2237 (setq overriding-map-is-bound nil)) | |
2238 | |
1621 (defun universal-argument () | 2239 (defun universal-argument () |
1622 "Begin a numeric argument for the following command. | 2240 "Begin a numeric argument for the following command. |
1623 Digits or minus sign following \\[universal-argument] make up the numeric argument. | 2241 Digits or minus sign following \\[universal-argument] make up the numeric argument. |
1624 \\[universal-argument] following the digits or minus sign ends the argument. | 2242 \\[universal-argument] following the digits or minus sign ends the argument. |
1625 \\[universal-argument] without digits or minus sign provides 4 as argument. | 2243 \\[universal-argument] without digits or minus sign provides 4 as argument. |
1629 which is different in effect from any particular numeric argument. | 2247 which is different in effect from any particular numeric argument. |
1630 These commands include \\[set-mark-command] and \\[start-kbd-macro]." | 2248 These commands include \\[set-mark-command] and \\[start-kbd-macro]." |
1631 (interactive) | 2249 (interactive) |
1632 (setq prefix-arg (list 4)) | 2250 (setq prefix-arg (list 4)) |
1633 (setq universal-argument-num-events (length (this-command-keys))) | 2251 (setq universal-argument-num-events (length (this-command-keys))) |
1634 (setq overriding-terminal-local-map universal-argument-map)) | 2252 (ensure-overriding-map-is-bound)) |
1635 | 2253 |
1636 ;; A subsequent C-u means to multiply the factor by 4 if we've typed | 2254 ;; A subsequent C-u means to multiply the factor by 4 if we've typed |
1637 ;; nothing but C-u's; otherwise it means to terminate the prefix arg. | 2255 ;; nothing but C-u's; otherwise it means to terminate the prefix arg. |
1638 (defun universal-argument-more (arg) | 2256 (defun universal-argument-more (arg) |
1639 (interactive "P") | 2257 (interactive "P") |
1640 (if (consp arg) | 2258 (if (consp arg) |
1641 (setq prefix-arg (list (* 4 (car arg)))) | 2259 (setq prefix-arg (list (* 4 (car arg)))) |
1642 (if (eq arg '-) | 2260 (if (eq arg '-) |
1643 (setq prefix-arg (list -4)) | 2261 (setq prefix-arg (list -4)) |
1644 (setq prefix-arg arg) | 2262 (setq prefix-arg arg) |
1645 (setq overriding-terminal-local-map nil))) | 2263 (restore-overriding-map))) |
1646 (setq universal-argument-num-events (length (this-command-keys)))) | 2264 (setq universal-argument-num-events (length (this-command-keys)))) |
1647 | 2265 |
1648 (defun negative-argument (arg) | 2266 (defun negative-argument (arg) |
1649 "Begin a negative numeric argument for the next command. | 2267 "Begin a negative numeric argument for the next command. |
1650 \\[universal-argument] following digits or minus sign ends the argument." | 2268 \\[universal-argument] following digits or minus sign ends the argument." |
1654 ((eq arg '-) | 2272 ((eq arg '-) |
1655 (setq prefix-arg nil)) | 2273 (setq prefix-arg nil)) |
1656 (t | 2274 (t |
1657 (setq prefix-arg '-))) | 2275 (setq prefix-arg '-))) |
1658 (setq universal-argument-num-events (length (this-command-keys))) | 2276 (setq universal-argument-num-events (length (this-command-keys))) |
1659 (setq overriding-terminal-local-map universal-argument-map)) | 2277 (ensure-overriding-map-is-bound)) |
1660 | 2278 |
1661 (defun digit-argument (arg) | 2279 (defun digit-argument (arg) |
1662 "Part of the numeric argument for the next command. | 2280 "Part of the numeric argument for the next command. |
1663 \\[universal-argument] following digits or minus sign ends the argument." | 2281 \\[universal-argument] following digits or minus sign ends the argument." |
1664 (interactive "P") | 2282 (interactive "P") |
1673 ;; Treat -0 as just -, so that -01 will work. | 2291 ;; Treat -0 as just -, so that -01 will work. |
1674 (setq prefix-arg (if (zerop digit) '- (- digit)))) | 2292 (setq prefix-arg (if (zerop digit) '- (- digit)))) |
1675 (t | 2293 (t |
1676 (setq prefix-arg digit)))) | 2294 (setq prefix-arg digit)))) |
1677 (setq universal-argument-num-events (length (this-command-keys))) | 2295 (setq universal-argument-num-events (length (this-command-keys))) |
1678 (setq overriding-terminal-local-map universal-argument-map)) | 2296 (ensure-overriding-map-is-bound)) |
1679 | 2297 |
1680 ;; For backward compatibility, minus with no modifiers is an ordinary | 2298 ;; For backward compatibility, minus with no modifiers is an ordinary |
1681 ;; command if digits have already been entered. | 2299 ;; command if digits have already been entered. |
1682 (defun universal-argument-minus (arg) | 2300 (defun universal-argument-minus (arg) |
1683 (interactive "P") | 2301 (interactive "P") |
1694 (keylist (listify-key-sequence key))) | 2312 (keylist (listify-key-sequence key))) |
1695 (setq unread-command-events | 2313 (setq unread-command-events |
1696 (append (nthcdr universal-argument-num-events keylist) | 2314 (append (nthcdr universal-argument-num-events keylist) |
1697 unread-command-events))) | 2315 unread-command-events))) |
1698 (reset-this-command-lengths) | 2316 (reset-this-command-lengths) |
1699 (setq overriding-terminal-local-map nil)) | 2317 (restore-overriding-map)) |
1700 | 2318 |
2319 (defvar buffer-substring-filters nil | |
2320 "List of filter functions for `filter-buffer-substring'. | |
2321 Each function must accept a single argument, a string, and return | |
2322 a string. The buffer substring is passed to the first function | |
2323 in the list, and the return value of each function is passed to | |
2324 the next. The return value of the last function is used as the | |
2325 return value of `filter-buffer-substring'. | |
2326 | |
2327 If this variable is nil, no filtering is performed.") | |
2328 | |
2329 (defun filter-buffer-substring (beg end &optional delete) | |
2330 "Return the buffer substring between BEG and END, after filtering. | |
2331 The buffer substring is passed through each of the filter | |
2332 functions in `buffer-substring-filters', and the value from the | |
2333 last filter function is returned. If `buffer-substring-filters' | |
2334 is nil, the buffer substring is returned unaltered. | |
2335 | |
2336 If DELETE is non-nil, the text between BEG and END is deleted | |
2337 from the buffer. | |
2338 | |
2339 Point is temporarily set to BEG before calling | |
2340 `buffer-substring-filters', in case the functions need to know | |
2341 where the text came from. | |
2342 | |
2343 This function should be used instead of `buffer-substring' or | |
2344 `delete-and-extract-region' when you want to allow filtering to | |
2345 take place. For example, major or minor modes can use | |
2346 `buffer-substring-filters' to extract characters that are special | |
2347 to a buffer, and should not be copied into other buffers." | |
2348 (save-excursion | |
2349 (goto-char beg) | |
2350 (let ((string (if delete (delete-and-extract-region beg end) | |
2351 (buffer-substring beg end)))) | |
2352 (dolist (filter buffer-substring-filters string) | |
2353 (setq string (funcall filter string)))))) | |
2354 | |
1701 ;;;; Window system cut and paste hooks. | 2355 ;;;; Window system cut and paste hooks. |
1702 | 2356 |
1703 (defvar interprogram-cut-function nil | 2357 (defvar interprogram-cut-function nil |
1704 "Function to call to make a killed region available to other programs. | 2358 "Function to call to make a killed region available to other programs. |
1705 | 2359 |
1710 programs. | 2364 programs. |
1711 | 2365 |
1712 The function takes one or two arguments. | 2366 The function takes one or two arguments. |
1713 The first argument, TEXT, is a string containing | 2367 The first argument, TEXT, is a string containing |
1714 the text which should be made available. | 2368 the text which should be made available. |
1715 The second, PUSH, if non-nil means this is a \"new\" kill; | 2369 The second, optional, argument PUSH, has the same meaning as the |
1716 nil means appending to an \"old\" kill.") | 2370 similar argument to `x-set-cut-buffer', which see.") |
1717 | 2371 |
1718 (defvar interprogram-paste-function nil | 2372 (defvar interprogram-paste-function nil |
1719 "Function to call to get text cut from other programs. | 2373 "Function to call to get text cut from other programs. |
1720 | 2374 |
1721 Most window systems provide some sort of facility for cutting and | 2375 Most window systems provide some sort of facility for cutting and |
1724 text that other programs have provided for pasting. | 2378 text that other programs have provided for pasting. |
1725 | 2379 |
1726 The function should be called with no arguments. If the function | 2380 The function should be called with no arguments. If the function |
1727 returns nil, then no other program has provided such text, and the top | 2381 returns nil, then no other program has provided such text, and the top |
1728 of the Emacs kill ring should be used. If the function returns a | 2382 of the Emacs kill ring should be used. If the function returns a |
1729 string, that string should be put in the kill ring as the latest kill. | 2383 string, then the caller of the function \(usually `current-kill') |
2384 should put this string in the kill ring as the latest kill. | |
1730 | 2385 |
1731 Note that the function should return a string only if a program other | 2386 Note that the function should return a string only if a program other |
1732 than Emacs has provided a string for pasting; if Emacs provided the | 2387 than Emacs has provided a string for pasting; if Emacs provided the |
1733 most recent string, the function should return nil. If it is | 2388 most recent string, the function should return nil. If it is |
1734 difficult to tell whether Emacs or some other program provided the | 2389 difficult to tell whether Emacs or some other program provided the |
1765 the front of the kill ring, rather than being added to the list. | 2420 the front of the kill ring, rather than being added to the list. |
1766 | 2421 |
1767 Optional third arguments YANK-HANDLER controls how the STRING is later | 2422 Optional third arguments YANK-HANDLER controls how the STRING is later |
1768 inserted into a buffer; see `insert-for-yank' for details. | 2423 inserted into a buffer; see `insert-for-yank' for details. |
1769 When a yank handler is specified, STRING must be non-empty (the yank | 2424 When a yank handler is specified, STRING must be non-empty (the yank |
1770 handler is stored as a `yank-handler'text property on STRING). | 2425 handler, if non-nil, is stored as a `yank-handler' text property on STRING). |
1771 | 2426 |
1772 When the yank handler has a non-nil PARAM element, the original STRING | 2427 When the yank handler has a non-nil PARAM element, the original STRING |
1773 argument is not used by `insert-for-yank'. However, since Lisp code | 2428 argument is not used by `insert-for-yank'. However, since Lisp code |
1774 may access and use elements from the kill-ring directly, the STRING | 2429 may access and use elements from the kill ring directly, the STRING |
1775 argument should still be a \"useful\" string for such uses." | 2430 argument should still be a \"useful\" string for such uses." |
1776 (if (> (length string) 0) | 2431 (if (> (length string) 0) |
1777 (if yank-handler | 2432 (if yank-handler |
1778 (put-text-property 0 1 'yank-handler yank-handler string) | 2433 (put-text-property 0 (length string) |
1779 (remove-list-of-text-properties 0 1 '(yank-handler) string)) | 2434 'yank-handler yank-handler string)) |
1780 (if yank-handler | 2435 (if yank-handler |
1781 (signal 'args-out-of-range | 2436 (signal 'args-out-of-range |
1782 (list string "yank-handler specified for empty string")))) | 2437 (list string "yank-handler specified for empty string")))) |
1783 (if (fboundp 'menu-bar-update-yank-menu) | 2438 (if (fboundp 'menu-bar-update-yank-menu) |
1784 (menu-bar-update-yank-menu string (and replace (car kill-ring)))) | 2439 (menu-bar-update-yank-menu string (and replace (car kill-ring)))) |
1785 (if (and replace kill-ring) | 2440 (if (and replace kill-ring) |
1786 (setcar kill-ring string) | 2441 (setcar kill-ring string) |
1787 (setq kill-ring (cons string kill-ring)) | 2442 (push string kill-ring) |
1788 (if (> (length kill-ring) kill-ring-max) | 2443 (if (> (length kill-ring) kill-ring-max) |
1789 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))) | 2444 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))) |
1790 (setq kill-ring-yank-pointer kill-ring) | 2445 (setq kill-ring-yank-pointer kill-ring) |
1791 (if interprogram-cut-function | 2446 (if interprogram-cut-function |
1792 (funcall interprogram-cut-function string (not replace)))) | 2447 (funcall interprogram-cut-function string (not replace)))) |
1793 | 2448 |
1794 (defun kill-append (string before-p &optional yank-handler) | 2449 (defun kill-append (string before-p &optional yank-handler) |
1795 "Append STRING to the end of the latest kill in the kill ring. | 2450 "Append STRING to the end of the latest kill in the kill ring. |
1796 If BEFORE-P is non-nil, prepend STRING to the kill. | 2451 If BEFORE-P is non-nil, prepend STRING to the kill. |
1797 Optional third argument YANK-HANDLER specifies the yank-handler text | 2452 Optional third argument YANK-HANDLER, if non-nil, specifies the |
1798 property to be set on the combined kill ring string. If the specified | 2453 yank-handler text property to be set on the combined kill ring |
1799 yank-handler arg differs from the yank-handler property of the latest | 2454 string. If the specified yank-handler arg differs from the |
1800 kill string, STRING is added as a new kill ring element instead of | 2455 yank-handler property of the latest kill string, this function |
1801 being appending to the last kill. | 2456 adds the combined string to the kill ring as a new element, |
2457 instead of replacing the last kill with it. | |
1802 If `interprogram-cut-function' is set, pass the resulting kill to it." | 2458 If `interprogram-cut-function' is set, pass the resulting kill to it." |
1803 (let* ((cur (car kill-ring))) | 2459 (let* ((cur (car kill-ring))) |
1804 (kill-new (if before-p (concat string cur) (concat cur string)) | 2460 (kill-new (if before-p (concat string cur) (concat cur string)) |
1805 (or (= (length cur) 0) | 2461 (or (= (length cur) 0) |
1806 (equal yank-handler (get-text-property 0 'yank-handler cur))) | 2462 (equal yank-handler (get-text-property 0 'yank-handler cur))) |
1858 If the buffer is read-only, Emacs will beep and refrain from deleting | 2514 If the buffer is read-only, Emacs will beep and refrain from deleting |
1859 the text, but put the text in the kill ring anyway. This means that | 2515 the text, but put the text in the kill ring anyway. This means that |
1860 you can use the killing commands to copy text from a read-only buffer. | 2516 you can use the killing commands to copy text from a read-only buffer. |
1861 | 2517 |
1862 This is the primitive for programs to kill text (as opposed to deleting it). | 2518 This is the primitive for programs to kill text (as opposed to deleting it). |
1863 Supply two arguments, character numbers indicating the stretch of text | 2519 Supply two arguments, character positions indicating the stretch of text |
1864 to be killed. | 2520 to be killed. |
1865 Any command that calls this function is a \"kill command\". | 2521 Any command that calls this function is a \"kill command\". |
1866 If the previous command was also a kill command, | 2522 If the previous command was also a kill command, |
1867 the text killed this time appends to the text killed last time | 2523 the text killed this time appends to the text killed last time |
1868 to make one entry in the kill ring. | 2524 to make one entry in the kill ring. |
1869 | 2525 |
1870 In Lisp code, optional third arg YANK-HANDLER specifies the yank-handler | 2526 In Lisp code, optional third arg YANK-HANDLER, if non-nil, |
1871 text property to be set on the killed text. See `insert-for-yank'." | 2527 specifies the yank-handler text property to be set on the killed |
2528 text. See `insert-for-yank'." | |
1872 (interactive "r") | 2529 (interactive "r") |
1873 (condition-case nil | 2530 (condition-case nil |
1874 (let ((string (delete-and-extract-region beg end))) | 2531 (let ((string (filter-buffer-substring beg end t))) |
1875 (when string ;STRING is nil if BEG = END | 2532 (when string ;STRING is nil if BEG = END |
1876 ;; Add that string to the kill ring, one way or another. | 2533 ;; Add that string to the kill ring, one way or another. |
1877 (if (eq last-command 'kill-region) | 2534 (if (eq last-command 'kill-region) |
1878 (kill-append string (< end beg) yank-handler) | 2535 (kill-append string (< end beg) yank-handler) |
1879 (kill-new string nil yank-handler))) | 2536 (kill-new string nil yank-handler))) |
1880 (setq this-command 'kill-region)) | 2537 (when (or string (eq last-command 'kill-region)) |
2538 (setq this-command 'kill-region)) | |
2539 nil) | |
1881 ((buffer-read-only text-read-only) | 2540 ((buffer-read-only text-read-only) |
1882 ;; The code above failed because the buffer, or some of the characters | 2541 ;; The code above failed because the buffer, or some of the characters |
1883 ;; in the region, are read-only. | 2542 ;; in the region, are read-only. |
1884 ;; We should beep, in case the user just isn't aware of this. | 2543 ;; We should beep, in case the user just isn't aware of this. |
1885 ;; However, there's no harm in putting | 2544 ;; However, there's no harm in putting |
1887 (copy-region-as-kill beg end) | 2546 (copy-region-as-kill beg end) |
1888 ;; Set this-command now, so it will be set even if we get an error. | 2547 ;; Set this-command now, so it will be set even if we get an error. |
1889 (setq this-command 'kill-region) | 2548 (setq this-command 'kill-region) |
1890 ;; This should barf, if appropriate, and give us the correct error. | 2549 ;; This should barf, if appropriate, and give us the correct error. |
1891 (if kill-read-only-ok | 2550 (if kill-read-only-ok |
1892 (message "Read only text copied to kill ring") | 2551 (progn (message "Read only text copied to kill ring") nil) |
1893 ;; Signal an error if the buffer is read-only. | 2552 ;; Signal an error if the buffer is read-only. |
1894 (barf-if-buffer-read-only) | 2553 (barf-if-buffer-read-only) |
1895 ;; If the buffer isn't read-only, the text is. | 2554 ;; If the buffer isn't read-only, the text is. |
1896 (signal 'text-read-only (list (current-buffer))))))) | 2555 (signal 'text-read-only (list (current-buffer))))))) |
1897 | 2556 |
1903 In Transient Mark mode, deactivate the mark. | 2562 In Transient Mark mode, deactivate the mark. |
1904 If `interprogram-cut-function' is non-nil, also save the text for a window | 2563 If `interprogram-cut-function' is non-nil, also save the text for a window |
1905 system cut and paste." | 2564 system cut and paste." |
1906 (interactive "r") | 2565 (interactive "r") |
1907 (if (eq last-command 'kill-region) | 2566 (if (eq last-command 'kill-region) |
1908 (kill-append (buffer-substring beg end) (< end beg)) | 2567 (kill-append (filter-buffer-substring beg end) (< end beg)) |
1909 (kill-new (buffer-substring beg end))) | 2568 (kill-new (filter-buffer-substring beg end))) |
1910 (if transient-mark-mode | 2569 (if transient-mark-mode |
1911 (setq deactivate-mark t)) | 2570 (setq deactivate-mark t)) |
1912 nil) | 2571 nil) |
1913 | 2572 |
1914 (defun kill-ring-save (beg end) | 2573 (defun kill-ring-save (beg end) |
1922 | 2581 |
1923 This command is similar to `copy-region-as-kill', except that it gives | 2582 This command is similar to `copy-region-as-kill', except that it gives |
1924 visual feedback indicating the extent of the region being copied." | 2583 visual feedback indicating the extent of the region being copied." |
1925 (interactive "r") | 2584 (interactive "r") |
1926 (copy-region-as-kill beg end) | 2585 (copy-region-as-kill beg end) |
2586 ;; This use of interactive-p is correct | |
2587 ;; because the code it controls just gives the user visual feedback. | |
1927 (if (interactive-p) | 2588 (if (interactive-p) |
1928 (let ((other-end (if (= (point) beg) end beg)) | 2589 (let ((other-end (if (= (point) beg) end beg)) |
1929 (opoint (point)) | 2590 (opoint (point)) |
1930 ;; Inhibit quitting so we can make a quit here | 2591 ;; Inhibit quitting so we can make a quit here |
1931 ;; look like a C-g typed as a command. | 2592 ;; look like a C-g typed as a command. |
1932 (inhibit-quit t)) | 2593 (inhibit-quit t)) |
1933 (if (pos-visible-in-window-p other-end (selected-window)) | 2594 (if (pos-visible-in-window-p other-end (selected-window)) |
1934 (unless transient-mark-mode | 2595 (unless (and transient-mark-mode |
2596 (face-background 'region)) | |
1935 ;; Swap point and mark. | 2597 ;; Swap point and mark. |
1936 (set-marker (mark-marker) (point) (current-buffer)) | 2598 (set-marker (mark-marker) (point) (current-buffer)) |
1937 (goto-char other-end) | 2599 (goto-char other-end) |
1938 (sit-for 1) | 2600 (sit-for blink-matching-delay) |
1939 ;; Swap back. | 2601 ;; Swap back. |
1940 (set-marker (mark-marker) other-end (current-buffer)) | 2602 (set-marker (mark-marker) other-end (current-buffer)) |
1941 (goto-char opoint) | 2603 (goto-char opoint) |
1942 ;; If user quit, deactivate the mark | 2604 ;; If user quit, deactivate the mark |
1943 ;; as C-g would as a command. | 2605 ;; as C-g would as a command. |
1966 ;; Yanking. | 2628 ;; Yanking. |
1967 | 2629 |
1968 ;; This is actually used in subr.el but defcustom does not work there. | 2630 ;; This is actually used in subr.el but defcustom does not work there. |
1969 (defcustom yank-excluded-properties | 2631 (defcustom yank-excluded-properties |
1970 '(read-only invisible intangible field mouse-face help-echo local-map keymap | 2632 '(read-only invisible intangible field mouse-face help-echo local-map keymap |
1971 yank-handler) | 2633 yank-handler follow-link) |
1972 "*Text properties to discard when yanking." | 2634 "*Text properties to discard when yanking. |
2635 The value should be a list of text properties to discard or t, | |
2636 which means to discard all text properties." | |
1973 :type '(choice (const :tag "All" t) (repeat symbol)) | 2637 :type '(choice (const :tag "All" t) (repeat symbol)) |
1974 :group 'editing | 2638 :group 'killing |
1975 :version "21.4") | 2639 :version "22.1") |
1976 | 2640 |
1977 (defvar yank-window-start nil) | 2641 (defvar yank-window-start nil) |
1978 (defvar yank-undo-function nil | 2642 (defvar yank-undo-function nil |
1979 "If non-nil, function used by `yank-pop' to delete last stretch of yanked text. | 2643 "If non-nil, function used by `yank-pop' to delete last stretch of yanked text. |
1980 Function is called with two parameters, START and END corresponding to | 2644 Function is called with two parameters, START and END corresponding to |
1981 the value of the mark and point; it is guaranteed that START <= END. | 2645 the value of the mark and point; it is guaranteed that START <= END. |
1982 Normally set from the UNDO element of a yank-handler; see `insert-for-yank'.") | 2646 Normally set from the UNDO element of a yank-handler; see `insert-for-yank'.") |
1983 | 2647 |
1984 (defun yank-pop (arg) | 2648 (defun yank-pop (&optional arg) |
1985 "Replace just-yanked stretch of killed text with a different stretch. | 2649 "Replace just-yanked stretch of killed text with a different stretch. |
1986 This command is allowed only immediately after a `yank' or a `yank-pop'. | 2650 This command is allowed only immediately after a `yank' or a `yank-pop'. |
1987 At such a time, the region contains a stretch of reinserted | 2651 At such a time, the region contains a stretch of reinserted |
1988 previously-killed text. `yank-pop' deletes that text and inserts in its | 2652 previously-killed text. `yank-pop' deletes that text and inserts in its |
1989 place a different stretch of killed text. | 2653 place a different stretch of killed text. |
1991 With no argument, the previous kill is inserted. | 2655 With no argument, the previous kill is inserted. |
1992 With argument N, insert the Nth previous kill. | 2656 With argument N, insert the Nth previous kill. |
1993 If N is negative, this is a more recent kill. | 2657 If N is negative, this is a more recent kill. |
1994 | 2658 |
1995 The sequence of kills wraps around, so that after the oldest one | 2659 The sequence of kills wraps around, so that after the oldest one |
1996 comes the newest one." | 2660 comes the newest one. |
2661 | |
2662 When this command inserts killed text into the buffer, it honors | |
2663 `yank-excluded-properties' and `yank-handler' as described in the | |
2664 doc string for `insert-for-yank-1', which see." | |
1997 (interactive "*p") | 2665 (interactive "*p") |
1998 (if (not (eq last-command 'yank)) | 2666 (if (not (eq last-command 'yank)) |
1999 (error "Previous command was not a yank")) | 2667 (error "Previous command was not a yank")) |
2000 (setq this-command 'yank) | 2668 (setq this-command 'yank) |
2669 (unless arg (setq arg 1)) | |
2001 (let ((inhibit-read-only t) | 2670 (let ((inhibit-read-only t) |
2002 (before (< (point) (mark t)))) | 2671 (before (< (point) (mark t)))) |
2003 (if before | 2672 (if before |
2004 (funcall (or yank-undo-function 'delete-region) (point) (mark t)) | 2673 (funcall (or yank-undo-function 'delete-region) (point) (mark t)) |
2005 (funcall (or yank-undo-function 'delete-region) (mark t) (point))) | 2674 (funcall (or yank-undo-function 'delete-region) (mark t) (point))) |
2022 More precisely, reinsert the stretch of killed text most recently | 2691 More precisely, reinsert the stretch of killed text most recently |
2023 killed OR yanked. Put point at end, and set mark at beginning. | 2692 killed OR yanked. Put point at end, and set mark at beginning. |
2024 With just \\[universal-argument] as argument, same but put point at beginning (and mark at end). | 2693 With just \\[universal-argument] as argument, same but put point at beginning (and mark at end). |
2025 With argument N, reinsert the Nth most recently killed stretch of killed | 2694 With argument N, reinsert the Nth most recently killed stretch of killed |
2026 text. | 2695 text. |
2696 | |
2697 When this command inserts killed text into the buffer, it honors | |
2698 `yank-excluded-properties' and `yank-handler' as described in the | |
2699 doc string for `insert-for-yank-1', which see. | |
2700 | |
2027 See also the command \\[yank-pop]." | 2701 See also the command \\[yank-pop]." |
2028 (interactive "*P") | 2702 (interactive "*P") |
2029 (setq yank-window-start (window-start)) | 2703 (setq yank-window-start (window-start)) |
2030 ;; If we don't get all the way thru, make last-command indicate that | 2704 ;; If we don't get all the way thru, make last-command indicate that |
2031 ;; for the following command. | 2705 ;; for the following command. |
2032 (setq this-command t) | 2706 (setq this-command t) |
2033 (push-mark (point)) | 2707 (push-mark (point)) |
2034 (insert-for-yank (current-kill (cond | 2708 (insert-for-yank (current-kill (cond |
2035 ((listp arg) 0) | 2709 ((listp arg) 0) |
2036 ((eq arg '-) -1) | 2710 ((eq arg '-) -2) |
2037 (t (1- arg))))) | 2711 (t (1- arg))))) |
2038 (if (consp arg) | 2712 (if (consp arg) |
2039 ;; This is like exchange-point-and-mark, but doesn't activate the mark. | 2713 ;; This is like exchange-point-and-mark, but doesn't activate the mark. |
2040 ;; It is cleaner to avoid activation, even though the command | 2714 ;; It is cleaner to avoid activation, even though the command |
2041 ;; loop would deactivate the mark because we inserted text. | 2715 ;; loop would deactivate the mark because we inserted text. |
2089 (while (and (> count 0) (not (bobp))) | 2763 (while (and (> count 0) (not (bobp))) |
2090 (if (= (preceding-char) ?\t) | 2764 (if (= (preceding-char) ?\t) |
2091 (let ((col (current-column))) | 2765 (let ((col (current-column))) |
2092 (forward-char -1) | 2766 (forward-char -1) |
2093 (setq col (- col (current-column))) | 2767 (setq col (- col (current-column))) |
2094 (insert-char ?\ col) | 2768 (insert-char ?\s col) |
2095 (delete-char 1))) | 2769 (delete-char 1))) |
2096 (forward-char -1) | 2770 (forward-char -1) |
2097 (setq count (1- count)))))) | 2771 (setq count (1- count)))))) |
2098 (delete-backward-char | 2772 (delete-backward-char |
2099 (let ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t") | 2773 (let ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t") |
2109 (defun zap-to-char (arg char) | 2783 (defun zap-to-char (arg char) |
2110 "Kill up to and including ARG'th occurrence of CHAR. | 2784 "Kill up to and including ARG'th occurrence of CHAR. |
2111 Case is ignored if `case-fold-search' is non-nil in the current buffer. | 2785 Case is ignored if `case-fold-search' is non-nil in the current buffer. |
2112 Goes backward if ARG is negative; error if CHAR not found." | 2786 Goes backward if ARG is negative; error if CHAR not found." |
2113 (interactive "p\ncZap to char: ") | 2787 (interactive "p\ncZap to char: ") |
2788 (if (char-table-p translation-table-for-input) | |
2789 (setq char (or (aref translation-table-for-input char) char))) | |
2114 (kill-region (point) (progn | 2790 (kill-region (point) (progn |
2115 (search-forward (char-to-string char) nil nil arg) | 2791 (search-forward (char-to-string char) nil nil arg) |
2116 ; (goto-char (if (> arg 0) (1- (point)) (1+ (point)))) | 2792 ; (goto-char (if (> arg 0) (1- (point)) (1+ (point)))) |
2117 (point)))) | 2793 (point)))) |
2118 | 2794 |
2143 If you want to append the killed line to the last killed text, | 2819 If you want to append the killed line to the last killed text, |
2144 use \\[append-next-kill] before \\[kill-line]. | 2820 use \\[append-next-kill] before \\[kill-line]. |
2145 | 2821 |
2146 If the buffer is read-only, Emacs will beep and refrain from deleting | 2822 If the buffer is read-only, Emacs will beep and refrain from deleting |
2147 the line, but put the line in the kill ring anyway. This means that | 2823 the line, but put the line in the kill ring anyway. This means that |
2148 you can use this command to copy text from a read-only buffer." | 2824 you can use this command to copy text from a read-only buffer. |
2825 \(If the variable `kill-read-only-ok' is non-nil, then this won't | |
2826 even beep.)" | |
2149 (interactive "P") | 2827 (interactive "P") |
2150 (kill-region (point) | 2828 (kill-region (point) |
2151 ;; It is better to move point to the other end of the kill | 2829 ;; It is better to move point to the other end of the kill |
2152 ;; before killing. That way, in a read-only buffer, point | 2830 ;; before killing. That way, in a read-only buffer, point |
2153 ;; moves across the text that is copied to the kill ring. | 2831 ;; moves across the text that is copied to the kill ring. |
2160 (signal 'end-of-buffer nil)) | 2838 (signal 'end-of-buffer nil)) |
2161 (let ((end | 2839 (let ((end |
2162 (save-excursion | 2840 (save-excursion |
2163 (end-of-visible-line) (point)))) | 2841 (end-of-visible-line) (point)))) |
2164 (if (or (save-excursion | 2842 (if (or (save-excursion |
2165 (skip-chars-forward " \t" end) | 2843 ;; If trailing whitespace is visible, |
2844 ;; don't treat it as nothing. | |
2845 (unless show-trailing-whitespace | |
2846 (skip-chars-forward " \t" end)) | |
2166 (= (point) end)) | 2847 (= (point) end)) |
2167 (and kill-whole-line (bolp))) | 2848 (and kill-whole-line (bolp))) |
2168 (forward-visible-line 1) | 2849 (forward-visible-line 1) |
2169 (goto-char end)))) | 2850 (goto-char end)))) |
2170 (point)))) | 2851 (point)))) |
2171 | 2852 |
2853 (defun kill-whole-line (&optional arg) | |
2854 "Kill current line. | |
2855 With prefix arg, kill that many lines starting from the current line. | |
2856 If arg is negative, kill backward. Also kill the preceding newline. | |
2857 \(This is meant to make \\[repeat] work well with negative arguments.\) | |
2858 If arg is zero, kill current line but exclude the trailing newline." | |
2859 (interactive "p") | |
2860 (if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp))) | |
2861 (signal 'end-of-buffer nil)) | |
2862 (if (and (< arg 0) (bobp) (save-excursion (end-of-visible-line) (bobp))) | |
2863 (signal 'beginning-of-buffer nil)) | |
2864 (unless (eq last-command 'kill-region) | |
2865 (kill-new "") | |
2866 (setq last-command 'kill-region)) | |
2867 (cond ((zerop arg) | |
2868 ;; We need to kill in two steps, because the previous command | |
2869 ;; could have been a kill command, in which case the text | |
2870 ;; before point needs to be prepended to the current kill | |
2871 ;; ring entry and the text after point appended. Also, we | |
2872 ;; need to use save-excursion to avoid copying the same text | |
2873 ;; twice to the kill ring in read-only buffers. | |
2874 (save-excursion | |
2875 (kill-region (point) (progn (forward-visible-line 0) (point)))) | |
2876 (kill-region (point) (progn (end-of-visible-line) (point)))) | |
2877 ((< arg 0) | |
2878 (save-excursion | |
2879 (kill-region (point) (progn (end-of-visible-line) (point)))) | |
2880 (kill-region (point) | |
2881 (progn (forward-visible-line (1+ arg)) | |
2882 (unless (bobp) (backward-char)) | |
2883 (point)))) | |
2884 (t | |
2885 (save-excursion | |
2886 (kill-region (point) (progn (forward-visible-line 0) (point)))) | |
2887 (kill-region (point) | |
2888 (progn (forward-visible-line arg) (point)))))) | |
2172 | 2889 |
2173 (defun forward-visible-line (arg) | 2890 (defun forward-visible-line (arg) |
2174 "Move forward by ARG lines, ignoring currently invisible newlines only. | 2891 "Move forward by ARG lines, ignoring currently invisible newlines only. |
2175 If ARG is negative, move backward -ARG lines. | 2892 If ARG is negative, move backward -ARG lines. |
2176 If ARG is zero, move to the beginning of the current line." | 2893 If ARG is zero, move to the beginning of the current line." |
2206 (point-max)) | 2923 (point-max)) |
2207 (next-overlay-change (point))))) | 2924 (next-overlay-change (point))))) |
2208 (unless (bolp) | 2925 (unless (bolp) |
2209 (goto-char opoint)))) | 2926 (goto-char opoint)))) |
2210 (let ((first t)) | 2927 (let ((first t)) |
2211 (while (or first (< arg 0)) | 2928 (while (or first (<= arg 0)) |
2212 (if (zerop arg) | 2929 (if first |
2213 (beginning-of-line) | 2930 (beginning-of-line) |
2214 (or (zerop (forward-line -1)) | 2931 (or (zerop (forward-line -1)) |
2215 (signal 'beginning-of-buffer nil))) | 2932 (signal 'beginning-of-buffer nil))) |
2216 ;; If the newline we just moved to is invisible, | 2933 ;; If the newline we just moved to is invisible, |
2217 ;; don't count it. | 2934 ;; don't count it. |
2218 (unless (bobp) | 2935 (unless (bobp) |
2219 (let ((prop | 2936 (let ((prop |
2220 (get-char-property (1- (point)) 'invisible))) | 2937 (get-char-property (1- (point)) 'invisible))) |
2221 (if (if (eq buffer-invisibility-spec t) | 2938 (unless (if (eq buffer-invisibility-spec t) |
2222 prop | 2939 prop |
2223 (or (memq prop buffer-invisibility-spec) | 2940 (or (memq prop buffer-invisibility-spec) |
2224 (assq prop buffer-invisibility-spec))) | 2941 (assq prop buffer-invisibility-spec))) |
2225 (setq arg (1+ arg))))) | 2942 (setq arg (1+ arg))))) |
2226 (setq first nil) | 2943 (setq first nil)) |
2227 (setq arg (1+ arg))) | |
2228 ;; If invisible text follows, and it is a number of complete lines, | 2944 ;; If invisible text follows, and it is a number of complete lines, |
2229 ;; skip it. | 2945 ;; skip it. |
2230 (let ((opoint (point))) | 2946 (let ((opoint (point))) |
2231 (while (and (not (bobp)) | 2947 (while (and (not (bobp)) |
2232 (let ((prop | 2948 (let ((prop |
2270 "Insert after point the contents of BUFFER. | 2986 "Insert after point the contents of BUFFER. |
2271 Puts mark after the inserted text. | 2987 Puts mark after the inserted text. |
2272 BUFFER may be a buffer or a buffer name. | 2988 BUFFER may be a buffer or a buffer name. |
2273 | 2989 |
2274 This function is meant for the user to run interactively. | 2990 This function is meant for the user to run interactively. |
2275 Don't call it from programs!" | 2991 Don't call it from programs: use `insert-buffer-substring' instead!" |
2276 (interactive | 2992 (interactive |
2277 (list | 2993 (list |
2278 (progn | 2994 (progn |
2279 (barf-if-buffer-read-only) | 2995 (barf-if-buffer-read-only) |
2280 (read-buffer "Insert buffer: " | 2996 (read-buffer "Insert buffer: " |
2281 (if (eq (selected-window) (next-window (selected-window))) | 2997 (if (eq (selected-window) (next-window (selected-window))) |
2282 (other-buffer (current-buffer)) | 2998 (other-buffer (current-buffer)) |
2283 (window-buffer (next-window (selected-window)))) | 2999 (window-buffer (next-window (selected-window)))) |
2284 t)))) | 3000 t)))) |
2285 (or (bufferp buffer) | 3001 (push-mark |
2286 (setq buffer (get-buffer buffer))) | 3002 (save-excursion |
2287 (let (start end newmark) | 3003 (insert-buffer-substring (get-buffer buffer)) |
2288 (save-excursion | 3004 (point))) |
2289 (save-excursion | |
2290 (set-buffer buffer) | |
2291 (setq start (point-min) end (point-max))) | |
2292 (insert-buffer-substring buffer start end) | |
2293 (setq newmark (point))) | |
2294 (push-mark newmark)) | |
2295 nil) | 3005 nil) |
2296 | 3006 |
2297 (defun append-to-buffer (buffer start end) | 3007 (defun append-to-buffer (buffer start end) |
2298 "Append to specified buffer the text of the region. | 3008 "Append to specified buffer the text of the region. |
2299 It is inserted into that buffer before its point. | 3009 It is inserted into that buffer before its point. |
2339 When calling from a program, give three arguments: | 3049 When calling from a program, give three arguments: |
2340 BUFFER (or buffer name), START and END. | 3050 BUFFER (or buffer name), START and END. |
2341 START and END specify the portion of the current buffer to be copied." | 3051 START and END specify the portion of the current buffer to be copied." |
2342 (interactive "BCopy to buffer: \nr") | 3052 (interactive "BCopy to buffer: \nr") |
2343 (let ((oldbuf (current-buffer))) | 3053 (let ((oldbuf (current-buffer))) |
2344 (save-excursion | 3054 (with-current-buffer (get-buffer-create buffer) |
2345 (set-buffer (get-buffer-create buffer)) | |
2346 (barf-if-buffer-read-only) | 3055 (barf-if-buffer-read-only) |
2347 (erase-buffer) | 3056 (erase-buffer) |
2348 (save-excursion | 3057 (save-excursion |
2349 (insert-buffer-substring oldbuf start end))))) | 3058 (insert-buffer-substring oldbuf start end))))) |
2350 | 3059 |
2351 (put 'mark-inactive 'error-conditions '(mark-inactive error)) | 3060 (put 'mark-inactive 'error-conditions '(mark-inactive error)) |
2352 (put 'mark-inactive 'error-message "The mark is not active now") | 3061 (put 'mark-inactive 'error-message "The mark is not active now") |
2353 | 3062 |
3063 (defvar activate-mark-hook nil | |
3064 "Hook run when the mark becomes active. | |
3065 It is also run at the end of a command, if the mark is active and | |
3066 it is possible that the region may have changed") | |
3067 | |
3068 (defvar deactivate-mark-hook nil | |
3069 "Hook run when the mark becomes inactive.") | |
3070 | |
2354 (defun mark (&optional force) | 3071 (defun mark (&optional force) |
2355 "Return this buffer's mark value as integer; error if mark inactive. | 3072 "Return this buffer's mark value as integer, or nil if never set. |
2356 If optional argument FORCE is non-nil, access the mark value | 3073 |
2357 even if the mark is not currently active, and return nil | 3074 In Transient Mark mode, this function signals an error if |
2358 if there is no mark at all. | 3075 the mark is not active. However, if `mark-even-if-inactive' is non-nil, |
3076 or the argument FORCE is non-nil, it disregards whether the mark | |
3077 is active, and returns an integer or nil in the usual way. | |
2359 | 3078 |
2360 If you are using this in an editing command, you are most likely making | 3079 If you are using this in an editing command, you are most likely making |
2361 a mistake; see the documentation of `set-mark'." | 3080 a mistake; see the documentation of `set-mark'." |
2362 (if (or force (not transient-mark-mode) mark-active mark-even-if-inactive) | 3081 (if (or force (not transient-mark-mode) mark-active mark-even-if-inactive) |
2363 (marker-position (mark-marker)) | 3082 (marker-position (mark-marker)) |
2381 That is to say, don't use this function unless you want | 3100 That is to say, don't use this function unless you want |
2382 the user to see that the mark has moved, and you want the previous | 3101 the user to see that the mark has moved, and you want the previous |
2383 mark position to be lost. | 3102 mark position to be lost. |
2384 | 3103 |
2385 Normally, when a new mark is set, the old one should go on the stack. | 3104 Normally, when a new mark is set, the old one should go on the stack. |
2386 This is why most applications should use push-mark, not set-mark. | 3105 This is why most applications should use `push-mark', not `set-mark'. |
2387 | 3106 |
2388 Novice Emacs Lisp programmers often try to use the mark for the wrong | 3107 Novice Emacs Lisp programmers often try to use the mark for the wrong |
2389 purposes. The mark saves a location for the user's convenience. | 3108 purposes. The mark saves a location for the user's convenience. |
2390 Most editing commands should not alter the mark. | 3109 Most editing commands should not alter the mark. |
2391 To remember a location for internal use in the Lisp program, | 3110 To remember a location for internal use in the Lisp program, |
2440 (interactive "P") | 3159 (interactive "P") |
2441 (let ((mark (marker-position (mark-marker)))) | 3160 (let ((mark (marker-position (mark-marker)))) |
2442 (if (or arg (null mark) (/= mark (point))) | 3161 (if (or arg (null mark) (/= mark (point))) |
2443 (push-mark nil nomsg t) | 3162 (push-mark nil nomsg t) |
2444 (setq mark-active t) | 3163 (setq mark-active t) |
3164 (run-hooks 'activate-mark-hook) | |
2445 (unless nomsg | 3165 (unless nomsg |
2446 (message "Mark activated"))))) | 3166 (message "Mark activated"))))) |
2447 | 3167 |
3168 (defcustom set-mark-command-repeat-pop nil | |
3169 "*Non-nil means that repeating \\[set-mark-command] after popping will pop. | |
3170 This means that if you type C-u \\[set-mark-command] \\[set-mark-command] | |
3171 will pop twice." | |
3172 :type 'boolean | |
3173 :group 'editing) | |
3174 | |
2448 (defun set-mark-command (arg) | 3175 (defun set-mark-command (arg) |
2449 "Set mark at where point is, or jump to mark. | 3176 "Set mark at where point is, or jump to mark. |
2450 With no prefix argument, set mark, push old mark position on local mark | 3177 With no prefix argument, set mark, and push old mark position on local |
2451 ring, and push mark on global mark ring. Immediately repeating the | 3178 mark ring; also push mark on global mark ring if last mark was set in |
2452 command activates `transient-mark-mode' temporarily. | 3179 another buffer. Immediately repeating the command activates |
2453 | 3180 `transient-mark-mode' temporarily. |
2454 With argument, jump to mark, and pop a new position for mark off the ring | 3181 |
2455 \(does not affect global mark ring\). Repeating the command without | 3182 With argument, e.g. \\[universal-argument] \\[set-mark-command], \ |
2456 an argument jumps to the next position off the mark ring. | 3183 jump to mark, and pop a new position |
3184 for mark off the local mark ring \(this does not affect the global | |
3185 mark ring\). Use \\[pop-global-mark] to jump to a mark off the global | |
3186 mark ring \(see `pop-global-mark'\). | |
3187 | |
3188 Repeating the \\[set-mark-command] command without the prefix jumps to | |
3189 the next position off the local (or global) mark ring. | |
3190 | |
3191 With a double \\[universal-argument] prefix argument, e.g. \\[universal-argument] \ | |
3192 \\[universal-argument] \\[set-mark-command], unconditionally | |
3193 set mark where point is. | |
2457 | 3194 |
2458 Novice Emacs Lisp programmers often try to use the mark for the wrong | 3195 Novice Emacs Lisp programmers often try to use the mark for the wrong |
2459 purposes. See the documentation of `set-mark' for more information." | 3196 purposes. See the documentation of `set-mark' for more information." |
2460 (interactive "P") | 3197 (interactive "P") |
2461 (if (eq transient-mark-mode 'lambda) | 3198 (if (eq transient-mark-mode 'lambda) |
2462 (setq transient-mark-mode nil)) | 3199 (setq transient-mark-mode nil)) |
2463 (cond | 3200 (cond |
3201 ((and (consp arg) (> (prefix-numeric-value arg) 4)) | |
3202 (push-mark-command nil)) | |
2464 ((not (eq this-command 'set-mark-command)) | 3203 ((not (eq this-command 'set-mark-command)) |
2465 (if arg | 3204 (if arg |
2466 (pop-to-mark-command) | 3205 (pop-to-mark-command) |
2467 (push-mark-command t))) | 3206 (push-mark-command t))) |
2468 ((eq last-command 'pop-to-mark-command) | 3207 ((and set-mark-command-repeat-pop |
2469 (if (and (consp arg) (> (prefix-numeric-value arg) 4)) | 3208 (eq last-command 'pop-to-mark-command)) |
2470 (push-mark-command nil) | 3209 (setq this-command 'pop-to-mark-command) |
2471 (setq this-command 'pop-to-mark-command) | 3210 (pop-to-mark-command)) |
2472 (pop-to-mark-command))) | 3211 ((and set-mark-command-repeat-pop |
3212 (eq last-command 'pop-global-mark) | |
3213 (not arg)) | |
3214 (setq this-command 'pop-global-mark) | |
3215 (pop-global-mark)) | |
2473 (arg | 3216 (arg |
2474 (setq this-command 'pop-to-mark-command) | 3217 (setq this-command 'pop-to-mark-command) |
2475 (pop-to-mark-command)) | 3218 (pop-to-mark-command)) |
2476 ((and (eq last-command 'set-mark-command) | 3219 ((and (eq last-command 'set-mark-command) |
2477 mark-active (null transient-mark-mode)) | 3220 mark-active (null transient-mark-mode)) |
2489 | 3232 |
2490 Novice Emacs Lisp programmers often try to use the mark for the wrong | 3233 Novice Emacs Lisp programmers often try to use the mark for the wrong |
2491 purposes. See the documentation of `set-mark' for more information. | 3234 purposes. See the documentation of `set-mark' for more information. |
2492 | 3235 |
2493 In Transient Mark mode, this does not activate the mark." | 3236 In Transient Mark mode, this does not activate the mark." |
2494 (if (null (mark t)) | 3237 (unless (null (mark t)) |
2495 nil | |
2496 (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring)) | 3238 (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring)) |
2497 (if (> (length mark-ring) mark-ring-max) | 3239 (when (> (length mark-ring) mark-ring-max) |
2498 (progn | 3240 (move-marker (car (nthcdr mark-ring-max mark-ring)) nil) |
2499 (move-marker (car (nthcdr mark-ring-max mark-ring)) nil) | 3241 (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))) |
2500 (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))) | |
2501 (set-marker (mark-marker) (or location (point)) (current-buffer)) | 3242 (set-marker (mark-marker) (or location (point)) (current-buffer)) |
2502 ;; Now push the mark on the global mark ring. | 3243 ;; Now push the mark on the global mark ring. |
2503 (if (and global-mark-ring | 3244 (if (and global-mark-ring |
2504 (eq (marker-buffer (car global-mark-ring)) (current-buffer))) | 3245 (eq (marker-buffer (car global-mark-ring)) (current-buffer))) |
2505 ;; The last global mark pushed was in this same buffer. | 3246 ;; The last global mark pushed was in this same buffer. |
2506 ;; Don't push another one. | 3247 ;; Don't push another one. |
2507 nil | 3248 nil |
2508 (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring)) | 3249 (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring)) |
2509 (if (> (length global-mark-ring) global-mark-ring-max) | 3250 (when (> (length global-mark-ring) global-mark-ring-max) |
2510 (progn | 3251 (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil) |
2511 (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) | 3252 (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))) |
2512 nil) | |
2513 (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))) | |
2514 (or nomsg executing-kbd-macro (> (minibuffer-depth) 0) | 3253 (or nomsg executing-kbd-macro (> (minibuffer-depth) 0) |
2515 (message "Mark set")) | 3254 (message "Mark set")) |
2516 (if (or activate (not transient-mark-mode)) | 3255 (if (or activate (not transient-mark-mode)) |
2517 (set-mark (mark t))) | 3256 (set-mark (mark t))) |
2518 nil) | 3257 nil) |
2519 | 3258 |
2520 (defun pop-mark () | 3259 (defun pop-mark () |
2521 "Pop off mark ring into the buffer's actual mark. | 3260 "Pop off mark ring into the buffer's actual mark. |
2522 Does not set point. Does nothing if mark ring is empty." | 3261 Does not set point. Does nothing if mark ring is empty." |
2523 (if mark-ring | 3262 (when mark-ring |
2524 (progn | 3263 (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker))))) |
2525 (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker))))) | 3264 (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer)) |
2526 (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer)) | 3265 (move-marker (car mark-ring) nil) |
2527 (deactivate-mark) | 3266 (if (null (mark t)) (ding)) |
2528 (move-marker (car mark-ring) nil) | 3267 (setq mark-ring (cdr mark-ring))) |
2529 (if (null (mark t)) (ding)) | 3268 (deactivate-mark)) |
2530 (setq mark-ring (cdr mark-ring))))) | |
2531 | 3269 |
2532 (defalias 'exchange-dot-and-mark 'exchange-point-and-mark) | 3270 (defalias 'exchange-dot-and-mark 'exchange-point-and-mark) |
2533 (defun exchange-point-and-mark (&optional arg) | 3271 (defun exchange-point-and-mark (&optional arg) |
2534 "Put the mark where point is now, and point where the mark is now. | 3272 "Put the mark where point is now, and point where the mark is now. |
2535 This command works even when the mark is not active, | 3273 This command works even when the mark is not active, |
2563 \\[keyboard-escape-quit]. | 3301 \\[keyboard-escape-quit]. |
2564 | 3302 |
2565 Many commands change their behavior when Transient Mark mode is in effect | 3303 Many commands change their behavior when Transient Mark mode is in effect |
2566 and the mark is active, by acting on the region instead of their usual | 3304 and the mark is active, by acting on the region instead of their usual |
2567 default part of the buffer's text. Examples of such commands include | 3305 default part of the buffer's text. Examples of such commands include |
2568 \\[comment-dwim], \\[flush-lines], \\[ispell], \\[keep-lines], | 3306 \\[comment-dwim], \\[flush-lines], \\[keep-lines], \ |
2569 \\[query-replace], \\[query-replace-regexp], and \\[undo]. Invoke | 3307 \\[query-replace], \\[query-replace-regexp], \\[ispell], and \\[undo]. |
2570 \\[apropos-documentation] and type \"transient\" or \"mark.*active\" at | 3308 Invoke \\[apropos-documentation] and type \"transient\" or |
2571 the prompt, to see the documentation of commands which are sensitive to | 3309 \"mark.*active\" at the prompt, to see the documentation of |
2572 the Transient Mark mode." | 3310 commands which are sensitive to the Transient Mark mode." |
2573 :global t :group 'editing-basics :require nil) | 3311 :global t :group 'editing-basics) |
3312 | |
3313 (defvar widen-automatically t | |
3314 "Non-nil means it is ok for commands to call `widen' when they want to. | |
3315 Some commands will do this in order to go to positions outside | |
3316 the current accessible part of the buffer. | |
3317 | |
3318 If `widen-automatically' is nil, these commands will do something else | |
3319 as a fallback, and won't change the buffer bounds.") | |
2574 | 3320 |
2575 (defun pop-global-mark () | 3321 (defun pop-global-mark () |
2576 "Pop off global mark ring and jump to the top location." | 3322 "Pop off global mark ring and jump to the top location." |
2577 (interactive) | 3323 (interactive) |
2578 ;; Pop entries which refer to non-existent buffers. | 3324 ;; Pop entries which refer to non-existent buffers. |
2586 (setq global-mark-ring (nconc (cdr global-mark-ring) | 3332 (setq global-mark-ring (nconc (cdr global-mark-ring) |
2587 (list (car global-mark-ring)))) | 3333 (list (car global-mark-ring)))) |
2588 (set-buffer buffer) | 3334 (set-buffer buffer) |
2589 (or (and (>= position (point-min)) | 3335 (or (and (>= position (point-min)) |
2590 (<= position (point-max))) | 3336 (<= position (point-max))) |
2591 (widen)) | 3337 (if widen-automatically |
3338 (widen) | |
3339 (error "Global mark position is outside accessible part of buffer"))) | |
2592 (goto-char position) | 3340 (goto-char position) |
2593 (switch-to-buffer buffer))) | 3341 (switch-to-buffer buffer))) |
2594 | 3342 |
2595 (defcustom next-line-add-newlines nil | 3343 (defcustom next-line-add-newlines nil |
2596 "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error." | 3344 "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error." |
2597 :type 'boolean | 3345 :type 'boolean |
2598 :version "21.1" | 3346 :version "21.1" |
2599 :group 'editing-basics) | 3347 :group 'editing-basics) |
2600 | 3348 |
2601 (defun next-line (&optional arg) | 3349 (defun next-line (&optional arg try-vscroll) |
2602 "Move cursor vertically down ARG lines. | 3350 "Move cursor vertically down ARG lines. |
3351 Interactively, vscroll tall lines if `auto-window-vscroll' is enabled. | |
2603 If there is no character in the target line exactly under the current column, | 3352 If there is no character in the target line exactly under the current column, |
2604 the cursor is positioned after the character in that line which spans this | 3353 the cursor is positioned after the character in that line which spans this |
2605 column, or at the end of the line if it is not long enough. | 3354 column, or at the end of the line if it is not long enough. |
2606 If there is no line in the buffer after this one, behavior depends on the | 3355 If there is no line in the buffer after this one, behavior depends on the |
2607 value of `next-line-add-newlines'. If non-nil, it inserts a newline character | 3356 value of `next-line-add-newlines'. If non-nil, it inserts a newline character |
2616 when there is no goal column. | 3365 when there is no goal column. |
2617 | 3366 |
2618 If you are thinking of using this in a Lisp program, consider | 3367 If you are thinking of using this in a Lisp program, consider |
2619 using `forward-line' instead. It is usually easier to use | 3368 using `forward-line' instead. It is usually easier to use |
2620 and more reliable (no dependence on goal column, etc.)." | 3369 and more reliable (no dependence on goal column, etc.)." |
2621 (interactive "p") | 3370 (interactive "p\np") |
2622 (unless arg (setq arg 1)) | 3371 (or arg (setq arg 1)) |
2623 (if (and next-line-add-newlines (= arg 1)) | 3372 (if (and next-line-add-newlines (= arg 1)) |
2624 (if (save-excursion (end-of-line) (eobp)) | 3373 (if (save-excursion (end-of-line) (eobp)) |
2625 ;; When adding a newline, don't expand an abbrev. | 3374 ;; When adding a newline, don't expand an abbrev. |
2626 (let ((abbrev-mode nil)) | 3375 (let ((abbrev-mode nil)) |
2627 (end-of-line) | 3376 (end-of-line) |
2628 (insert "\n")) | 3377 (insert (if use-hard-newlines hard-newline "\n"))) |
2629 (line-move arg)) | 3378 (line-move arg nil nil try-vscroll)) |
2630 (if (interactive-p) | 3379 (if (interactive-p) |
2631 (condition-case nil | 3380 (condition-case nil |
2632 (line-move arg) | 3381 (line-move arg nil nil try-vscroll) |
2633 ((beginning-of-buffer end-of-buffer) (ding))) | 3382 ((beginning-of-buffer end-of-buffer) (ding))) |
2634 (line-move arg))) | 3383 (line-move arg nil nil try-vscroll))) |
2635 nil) | 3384 nil) |
2636 | 3385 |
2637 (defun previous-line (&optional arg) | 3386 (defun previous-line (&optional arg try-vscroll) |
2638 "Move cursor vertically up ARG lines. | 3387 "Move cursor vertically up ARG lines. |
3388 Interactively, vscroll tall lines if `auto-window-vscroll' is enabled. | |
2639 If there is no character in the target line exactly over the current column, | 3389 If there is no character in the target line exactly over the current column, |
2640 the cursor is positioned after the character in that line which spans this | 3390 the cursor is positioned after the character in that line which spans this |
2641 column, or at the end of the line if it is not long enough. | 3391 column, or at the end of the line if it is not long enough. |
2642 | 3392 |
2643 The command \\[set-goal-column] can be used to create | 3393 The command \\[set-goal-column] can be used to create |
2648 when there is no goal column. | 3398 when there is no goal column. |
2649 | 3399 |
2650 If you are thinking of using this in a Lisp program, consider using | 3400 If you are thinking of using this in a Lisp program, consider using |
2651 `forward-line' with a negative argument instead. It is usually easier | 3401 `forward-line' with a negative argument instead. It is usually easier |
2652 to use and more reliable (no dependence on goal column, etc.)." | 3402 to use and more reliable (no dependence on goal column, etc.)." |
2653 (interactive "p") | 3403 (interactive "p\np") |
2654 (unless arg (setq arg 1)) | 3404 (or arg (setq arg 1)) |
2655 (if (interactive-p) | 3405 (if (interactive-p) |
2656 (condition-case nil | 3406 (condition-case nil |
2657 (line-move (- arg)) | 3407 (line-move (- arg) nil nil try-vscroll) |
2658 ((beginning-of-buffer end-of-buffer) (ding))) | 3408 ((beginning-of-buffer end-of-buffer) (ding))) |
2659 (line-move (- arg))) | 3409 (line-move (- arg) nil nil try-vscroll)) |
2660 nil) | 3410 nil) |
2661 | 3411 |
2662 (defcustom track-eol nil | 3412 (defcustom track-eol nil |
2663 "*Non-nil means vertical motion starting at end of line keeps to ends of lines. | 3413 "*Non-nil means vertical motion starting at end of line keeps to ends of lines. |
2664 This means moving to the end of each line moved onto. | 3414 This means moving to the end of each line moved onto. |
2677 "Current goal column for vertical motion. | 3427 "Current goal column for vertical motion. |
2678 It is the column where point was | 3428 It is the column where point was |
2679 at the start of current run of vertical motion commands. | 3429 at the start of current run of vertical motion commands. |
2680 When the `track-eol' feature is doing its job, the value is 9999.") | 3430 When the `track-eol' feature is doing its job, the value is 9999.") |
2681 | 3431 |
2682 (defcustom line-move-ignore-invisible nil | 3432 (defcustom line-move-ignore-invisible t |
2683 "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines. | 3433 "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines. |
2684 Outline mode sets this." | 3434 Outline mode sets this." |
2685 :type 'boolean | 3435 :type 'boolean |
2686 :group 'editing-basics) | 3436 :group 'editing-basics) |
2687 | 3437 |
2688 (defun line-move-invisible (pos) | 3438 (defun line-move-invisible-p (pos) |
2689 "Return non-nil if the character after POS is currently invisible." | 3439 "Return non-nil if the character after POS is currently invisible." |
2690 (let ((prop | 3440 (let ((prop |
2691 (get-char-property pos 'invisible))) | 3441 (get-char-property pos 'invisible))) |
2692 (if (eq buffer-invisibility-spec t) | 3442 (if (eq buffer-invisibility-spec t) |
2693 prop | 3443 prop |
2694 (or (memq prop buffer-invisibility-spec) | 3444 (or (memq prop buffer-invisibility-spec) |
2695 (assq prop buffer-invisibility-spec))))) | 3445 (assq prop buffer-invisibility-spec))))) |
2696 | 3446 |
3447 ;; This is like line-move-1 except that it also performs | |
3448 ;; vertical scrolling of tall images if appropriate. | |
3449 ;; That is not really a clean thing to do, since it mixes | |
3450 ;; scrolling with cursor motion. But so far we don't have | |
3451 ;; a cleaner solution to the problem of making C-n do something | |
3452 ;; useful given a tall image. | |
3453 (defun line-move (arg &optional noerror to-end try-vscroll) | |
3454 (if (and auto-window-vscroll try-vscroll | |
3455 ;; But don't vscroll in a keyboard macro. | |
3456 (not defining-kbd-macro) | |
3457 (not executing-kbd-macro)) | |
3458 (let ((forward (> arg 0)) | |
3459 (part (nth 2 (pos-visible-in-window-p (point) nil t)))) | |
3460 (if (and (consp part) | |
3461 (> (if forward (cdr part) (car part)) 0)) | |
3462 (set-window-vscroll nil | |
3463 (if forward | |
3464 (+ (window-vscroll nil t) | |
3465 (min (cdr part) | |
3466 (* (frame-char-height) arg))) | |
3467 (max 0 | |
3468 (- (window-vscroll nil t) | |
3469 (min (car part) | |
3470 (* (frame-char-height) (- arg)))))) | |
3471 t) | |
3472 (set-window-vscroll nil 0) | |
3473 (when (line-move-1 arg noerror to-end) | |
3474 (when (not forward) | |
3475 ;; Update display before calling pos-visible-in-window-p, | |
3476 ;; because it depends on window-start being up-to-date. | |
3477 (sit-for 0) | |
3478 ;; If the current line is partly hidden at the bottom, | |
3479 ;; scroll it partially up so as to unhide the bottom. | |
3480 (if (and (setq part (nth 2 (pos-visible-in-window-p | |
3481 (line-beginning-position) nil t))) | |
3482 (> (cdr part) 0)) | |
3483 (set-window-vscroll nil (cdr part) t))) | |
3484 t))) | |
3485 (line-move-1 arg noerror to-end))) | |
3486 | |
2697 ;; This is the guts of next-line and previous-line. | 3487 ;; This is the guts of next-line and previous-line. |
2698 ;; Arg says how many lines to move. | 3488 ;; Arg says how many lines to move. |
2699 (defun line-move (arg) | 3489 ;; The value is t if we can move the specified number of lines. |
3490 (defun line-move-1 (arg &optional noerror to-end) | |
2700 ;; Don't run any point-motion hooks, and disregard intangibility, | 3491 ;; Don't run any point-motion hooks, and disregard intangibility, |
2701 ;; for intermediate positions. | 3492 ;; for intermediate positions. |
2702 (let ((inhibit-point-motion-hooks t) | 3493 (let ((inhibit-point-motion-hooks t) |
2703 (opoint (point)) | 3494 (opoint (point)) |
2704 new line-end line-beg) | 3495 (forward (> arg 0))) |
2705 (unwind-protect | 3496 (unwind-protect |
2706 (progn | 3497 (progn |
2707 (if (not (memq last-command '(next-line previous-line))) | 3498 (if (not (memq last-command '(next-line previous-line))) |
2708 (setq temporary-goal-column | 3499 (setq temporary-goal-column |
2709 (if (and track-eol (eolp) | 3500 (if (and track-eol (eolp) |
2710 ;; Don't count beg of empty line as end of line | 3501 ;; Don't count beg of empty line as end of line |
2711 ;; unless we just did explicit end-of-line. | 3502 ;; unless we just did explicit end-of-line. |
2712 (or (not (bolp)) (eq last-command 'end-of-line))) | 3503 (or (not (bolp)) (eq last-command 'end-of-line))) |
2713 9999 | 3504 9999 |
2714 (current-column)))) | 3505 (current-column)))) |
3506 | |
2715 (if (and (not (integerp selective-display)) | 3507 (if (and (not (integerp selective-display)) |
2716 (not line-move-ignore-invisible)) | 3508 (not line-move-ignore-invisible)) |
2717 ;; Use just newline characters. | 3509 ;; Use just newline characters. |
2718 ;; Set ARG to 0 if we move as many lines as requested. | 3510 ;; Set ARG to 0 if we move as many lines as requested. |
2719 (or (if (> arg 0) | 3511 (or (if (> arg 0) |
2725 (if (zerop (forward-line 1)) | 3517 (if (zerop (forward-line 1)) |
2726 (setq arg 0))) | 3518 (setq arg 0))) |
2727 (and (zerop (forward-line arg)) | 3519 (and (zerop (forward-line arg)) |
2728 (bolp) | 3520 (bolp) |
2729 (setq arg 0))) | 3521 (setq arg 0))) |
2730 (signal (if (< arg 0) | 3522 (unless noerror |
2731 'beginning-of-buffer | 3523 (signal (if (< arg 0) |
2732 'end-of-buffer) | 3524 'beginning-of-buffer |
2733 nil)) | 3525 'end-of-buffer) |
3526 nil))) | |
2734 ;; Move by arg lines, but ignore invisible ones. | 3527 ;; Move by arg lines, but ignore invisible ones. |
2735 (while (> arg 0) | 3528 (let (done) |
2736 ;; If the following character is currently invisible, | 3529 (while (and (> arg 0) (not done)) |
2737 ;; skip all characters with that same `invisible' property value. | 3530 ;; If the following character is currently invisible, |
2738 (while (and (not (eobp)) (line-move-invisible (point))) | 3531 ;; skip all characters with that same `invisible' property value. |
2739 (goto-char (next-char-property-change (point)))) | 3532 (while (and (not (eobp)) (line-move-invisible-p (point))) |
2740 ;; Now move a line. | 3533 (goto-char (next-char-property-change (point)))) |
2741 (end-of-line) | 3534 ;; Now move a line. |
2742 (and (zerop (vertical-motion 1)) | 3535 (end-of-line) |
2743 (signal 'end-of-buffer nil)) | 3536 ;; If there's no invisibility here, move over the newline. |
2744 (setq arg (1- arg))) | 3537 (cond |
2745 (while (< arg 0) | 3538 ((eobp) |
2746 (beginning-of-line) | 3539 (if (not noerror) |
2747 (and (zerop (vertical-motion -1)) | 3540 (signal 'end-of-buffer nil) |
2748 (signal 'beginning-of-buffer nil)) | 3541 (setq done t))) |
2749 (setq arg (1+ arg)) | 3542 ((and (> arg 1) ;; Use vertical-motion for last move |
2750 (while (and (not (bobp)) (line-move-invisible (1- (point)))) | 3543 (not (integerp selective-display)) |
2751 (goto-char (previous-char-property-change (point))))))) | 3544 (not (line-move-invisible-p (point)))) |
3545 ;; We avoid vertical-motion when possible | |
3546 ;; because that has to fontify. | |
3547 (forward-line 1)) | |
3548 ;; Otherwise move a more sophisticated way. | |
3549 ((zerop (vertical-motion 1)) | |
3550 (if (not noerror) | |
3551 (signal 'end-of-buffer nil) | |
3552 (setq done t)))) | |
3553 (unless done | |
3554 (setq arg (1- arg)))) | |
3555 ;; The logic of this is the same as the loop above, | |
3556 ;; it just goes in the other direction. | |
3557 (while (and (< arg 0) (not done)) | |
3558 (beginning-of-line) | |
3559 (cond | |
3560 ((bobp) | |
3561 (if (not noerror) | |
3562 (signal 'beginning-of-buffer nil) | |
3563 (setq done t))) | |
3564 ((and (< arg -1) ;; Use vertical-motion for last move | |
3565 (not (integerp selective-display)) | |
3566 (not (line-move-invisible-p (1- (point))))) | |
3567 (forward-line -1)) | |
3568 ((zerop (vertical-motion -1)) | |
3569 (if (not noerror) | |
3570 (signal 'beginning-of-buffer nil) | |
3571 (setq done t)))) | |
3572 (unless done | |
3573 (setq arg (1+ arg)) | |
3574 (while (and ;; Don't move over previous invis lines | |
3575 ;; if our target is the middle of this line. | |
3576 (or (zerop (or goal-column temporary-goal-column)) | |
3577 (< arg 0)) | |
3578 (not (bobp)) (line-move-invisible-p (1- (point)))) | |
3579 (goto-char (previous-char-property-change (point)))))))) | |
3580 ;; This is the value the function returns. | |
3581 (= arg 0)) | |
2752 | 3582 |
2753 (cond ((> arg 0) | 3583 (cond ((> arg 0) |
2754 ;; If we did not move down as far as desired, | 3584 ;; If we did not move down as far as desired, |
2755 ;; at least go to end of line. | 3585 ;; at least go to end of line. |
2756 (end-of-line)) | 3586 (end-of-line)) |
2757 ((< arg 0) | 3587 ((< arg 0) |
2758 ;; If we did not move down as far as desired, | 3588 ;; If we did not move up as far as desired, |
2759 ;; at least go to end of line. | 3589 ;; at least go to beginning of line. |
2760 (beginning-of-line)) | 3590 (beginning-of-line)) |
2761 (t | 3591 (t |
2762 (line-move-finish (or goal-column temporary-goal-column) opoint))))) | 3592 (line-move-finish (or goal-column temporary-goal-column) |
2763 nil) | 3593 opoint forward)))))) |
2764 | 3594 |
2765 (defun line-move-finish (column opoint) | 3595 (defun line-move-finish (column opoint forward) |
2766 (let ((repeat t)) | 3596 (let ((repeat t)) |
2767 (while repeat | 3597 (while repeat |
2768 ;; Set REPEAT to t to repeat the whole thing. | 3598 ;; Set REPEAT to t to repeat the whole thing. |
2769 (setq repeat nil) | 3599 (setq repeat nil) |
2770 | 3600 |
2771 (let (new | 3601 (let (new |
2772 (line-beg (save-excursion (beginning-of-line) (point))) | 3602 (line-beg (save-excursion (beginning-of-line) (point))) |
2773 (line-end | 3603 (line-end |
2774 ;; Compute the end of the line | 3604 ;; Compute the end of the line |
2775 ;; ignoring effectively intangible newlines. | 3605 ;; ignoring effectively invisible newlines. |
2776 (let ((inhibit-point-motion-hooks nil) | 3606 (save-excursion |
2777 (inhibit-field-text-motion t)) | 3607 ;; Like end-of-line but ignores fields. |
2778 (save-excursion (end-of-line) (point))))) | 3608 (skip-chars-forward "^\n") |
3609 (while (and (not (eobp)) (line-move-invisible-p (point))) | |
3610 (goto-char (next-char-property-change (point))) | |
3611 (skip-chars-forward "^\n")) | |
3612 (point)))) | |
2779 | 3613 |
2780 ;; Move to the desired column. | 3614 ;; Move to the desired column. |
2781 (line-move-to-column column) | 3615 (line-move-to-column column) |
2782 (setq new (point)) | 3616 (setq new (point)) |
2783 | 3617 |
2795 (setq new (point)) | 3629 (setq new (point)) |
2796 ;; If that position is "too late", | 3630 ;; If that position is "too late", |
2797 ;; try the previous allowable position. | 3631 ;; try the previous allowable position. |
2798 ;; See if it is ok. | 3632 ;; See if it is ok. |
2799 (backward-char) | 3633 (backward-char) |
2800 (if (<= (point) line-end) | 3634 (if (if forward |
3635 ;; If going forward, don't accept the previous | |
3636 ;; allowable position if it is before the target line. | |
3637 (< line-beg (point)) | |
3638 ;; If going backward, don't accept the previous | |
3639 ;; allowable position if it is still after the target line. | |
3640 (<= (point) line-end)) | |
2801 (setq new (point)) | 3641 (setq new (point)) |
2802 ;; As a last resort, use the end of the line. | 3642 ;; As a last resort, use the end of the line. |
2803 (setq new line-end)))) | 3643 (setq new line-end)))) |
2804 | 3644 |
2805 ;; Now move to the updated destination, processing fields | 3645 ;; Now move to the updated destination, processing fields |
2824 (if (zerop col) | 3664 (if (zerop col) |
2825 (beginning-of-line) | 3665 (beginning-of-line) |
2826 (move-to-column col)) | 3666 (move-to-column col)) |
2827 | 3667 |
2828 (when (and line-move-ignore-invisible | 3668 (when (and line-move-ignore-invisible |
2829 (not (bolp)) (line-move-invisible (1- (point)))) | 3669 (not (bolp)) (line-move-invisible-p (1- (point)))) |
2830 (let ((normal-location (point)) | 3670 (let ((normal-location (point)) |
2831 (normal-column (current-column))) | 3671 (normal-column (current-column))) |
2832 ;; If the following character is currently invisible, | 3672 ;; If the following character is currently invisible, |
2833 ;; skip all characters with that same `invisible' property value. | 3673 ;; skip all characters with that same `invisible' property value. |
2834 (while (and (not (eobp)) | 3674 (while (and (not (eobp)) |
2835 (line-move-invisible (point))) | 3675 (line-move-invisible-p (point))) |
2836 (goto-char (next-char-property-change (point)))) | 3676 (goto-char (next-char-property-change (point)))) |
2837 ;; Have we advanced to a larger column position? | 3677 ;; Have we advanced to a larger column position? |
2838 (if (> (current-column) normal-column) | 3678 (if (> (current-column) normal-column) |
2839 ;; We have made some progress towards the desired column. | 3679 ;; We have made some progress towards the desired column. |
2840 ;; See if we can make any further progress. | 3680 ;; See if we can make any further progress. |
2843 ;; and move back over invisible text. | 3683 ;; and move back over invisible text. |
2844 ;; that will get us to the same place on the screen | 3684 ;; that will get us to the same place on the screen |
2845 ;; but with a more reasonable buffer position. | 3685 ;; but with a more reasonable buffer position. |
2846 (goto-char normal-location) | 3686 (goto-char normal-location) |
2847 (let ((line-beg (save-excursion (beginning-of-line) (point)))) | 3687 (let ((line-beg (save-excursion (beginning-of-line) (point)))) |
2848 (while (and (not (bolp)) (line-move-invisible (1- (point)))) | 3688 (while (and (not (bolp)) (line-move-invisible-p (1- (point)))) |
2849 (goto-char (previous-char-property-change (point) line-beg)))))))) | 3689 (goto-char (previous-char-property-change (point) line-beg)))))))) |
3690 | |
3691 (defun move-end-of-line (arg) | |
3692 "Move point to end of current line as displayed. | |
3693 \(If there's an image in the line, this disregards newlines | |
3694 which are part of the text that the image rests on.) | |
3695 | |
3696 With argument ARG not nil or 1, move forward ARG - 1 lines first. | |
3697 If point reaches the beginning or end of buffer, it stops there. | |
3698 To ignore intangibility, bind `inhibit-point-motion-hooks' to t." | |
3699 (interactive "p") | |
3700 (or arg (setq arg 1)) | |
3701 (let (done) | |
3702 (while (not done) | |
3703 (let ((newpos | |
3704 (save-excursion | |
3705 (let ((goal-column 0)) | |
3706 (and (line-move arg t) | |
3707 (not (bobp)) | |
3708 (progn | |
3709 (while (and (not (bobp)) (line-move-invisible-p (1- (point)))) | |
3710 (goto-char (previous-char-property-change (point)))) | |
3711 (backward-char 1))) | |
3712 (point))))) | |
3713 (goto-char newpos) | |
3714 (if (and (> (point) newpos) | |
3715 (eq (preceding-char) ?\n)) | |
3716 (backward-char 1) | |
3717 (if (and (> (point) newpos) (not (eobp)) | |
3718 (not (eq (following-char) ?\n))) | |
3719 ;; If we skipped something intangible | |
3720 ;; and now we're not really at eol, | |
3721 ;; keep going. | |
3722 (setq arg 1) | |
3723 (setq done t))))))) | |
3724 | |
3725 (defun move-beginning-of-line (arg) | |
3726 "Move point to beginning of current line as displayed. | |
3727 \(If there's an image in the line, this disregards newlines | |
3728 which are part of the text that the image rests on.) | |
3729 | |
3730 With argument ARG not nil or 1, move forward ARG - 1 lines first. | |
3731 If point reaches the beginning or end of buffer, it stops there. | |
3732 To ignore intangibility, bind `inhibit-point-motion-hooks' to t." | |
3733 (interactive "p") | |
3734 (or arg (setq arg 1)) | |
3735 (if (/= arg 1) | |
3736 (line-move (1- arg) t)) | |
3737 (beginning-of-line 1) | |
3738 (let ((orig (point))) | |
3739 (vertical-motion 0) | |
3740 (if (/= orig (point)) | |
3741 (goto-char (constrain-to-field (point) orig (/= arg 1) t nil))))) | |
3742 | |
2850 | 3743 |
2851 ;;; Many people have said they rarely use this feature, and often type | 3744 ;;; Many people have said they rarely use this feature, and often type |
2852 ;;; it by accident. Maybe it shouldn't even be on a key. | 3745 ;;; it by accident. Maybe it shouldn't even be on a key. |
2853 (put 'set-goal-column 'disabled t) | 3746 (put 'set-goal-column 'disabled t) |
2854 | 3747 |
2863 (if arg | 3756 (if arg |
2864 (progn | 3757 (progn |
2865 (setq goal-column nil) | 3758 (setq goal-column nil) |
2866 (message "No goal column")) | 3759 (message "No goal column")) |
2867 (setq goal-column (current-column)) | 3760 (setq goal-column (current-column)) |
2868 (message (substitute-command-keys | 3761 ;; The older method below can be erroneous if `set-goal-column' is bound |
2869 "Goal column %d (use \\[set-goal-column] with an arg to unset it)") | 3762 ;; to a sequence containing % |
2870 goal-column)) | 3763 ;;(message (substitute-command-keys |
3764 ;;"Goal column %d (use \\[set-goal-column] with an arg to unset it)") | |
3765 ;;goal-column) | |
3766 (message "%s" | |
3767 (concat | |
3768 (format "Goal column %d " goal-column) | |
3769 (substitute-command-keys | |
3770 "(use \\[set-goal-column] with an arg to unset it)"))) | |
3771 | |
3772 ) | |
2871 nil) | 3773 nil) |
2872 | 3774 |
2873 | 3775 |
2874 (defun scroll-other-window-down (lines) | 3776 (defun scroll-other-window-down (lines) |
2875 "Scroll the \"other window\" down. | 3777 "Scroll the \"other window\" down. |
2879 ;; Just invert the argument's meaning. | 3781 ;; Just invert the argument's meaning. |
2880 ;; We can do that without knowing which window it will be. | 3782 ;; We can do that without knowing which window it will be. |
2881 (if (eq lines '-) nil | 3783 (if (eq lines '-) nil |
2882 (if (null lines) '- | 3784 (if (null lines) '- |
2883 (- (prefix-numeric-value lines)))))) | 3785 (- (prefix-numeric-value lines)))))) |
2884 (define-key esc-map [?\C-\S-v] 'scroll-other-window-down) | |
2885 | 3786 |
2886 (defun beginning-of-buffer-other-window (arg) | 3787 (defun beginning-of-buffer-other-window (arg) |
2887 "Move point to the beginning of the buffer in the other window. | 3788 "Move point to the beginning of the buffer in the other window. |
2888 Leave mark at previous position. | 3789 Leave mark at previous position. |
2889 With arg N, put point N/10 of the way from the true beginning." | 3790 With arg N, put point N/10 of the way from the true beginning." |
2894 ;; because the latter would preserve the things we want to change. | 3795 ;; because the latter would preserve the things we want to change. |
2895 (unwind-protect | 3796 (unwind-protect |
2896 (progn | 3797 (progn |
2897 (select-window window) | 3798 (select-window window) |
2898 ;; Set point and mark in that window's buffer. | 3799 ;; Set point and mark in that window's buffer. |
2899 (beginning-of-buffer arg) | 3800 (with-no-warnings |
3801 (beginning-of-buffer arg)) | |
2900 ;; Set point accordingly. | 3802 ;; Set point accordingly. |
2901 (recenter '(t))) | 3803 (recenter '(t))) |
2902 (select-window orig-window)))) | 3804 (select-window orig-window)))) |
2903 | 3805 |
2904 (defun end-of-buffer-other-window (arg) | 3806 (defun end-of-buffer-other-window (arg) |
2910 (let ((orig-window (selected-window)) | 3812 (let ((orig-window (selected-window)) |
2911 (window (other-window-for-scrolling))) | 3813 (window (other-window-for-scrolling))) |
2912 (unwind-protect | 3814 (unwind-protect |
2913 (progn | 3815 (progn |
2914 (select-window window) | 3816 (select-window window) |
2915 (end-of-buffer arg) | 3817 (with-no-warnings |
3818 (end-of-buffer arg)) | |
2916 (recenter '(t))) | 3819 (recenter '(t))) |
2917 (select-window orig-window)))) | 3820 (select-window orig-window)))) |
2918 | 3821 |
2919 (defun transpose-chars (arg) | 3822 (defun transpose-chars (arg) |
2920 "Interchange characters around point, moving forward one character. | 3823 "Interchange characters around point, moving forward one character. |
3021 (let ((swap pos1)) | 3924 (let ((swap pos1)) |
3022 (setq pos1 pos2 pos2 swap))) | 3925 (setq pos1 pos2 pos2 swap))) |
3023 (if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose")) | 3926 (if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose")) |
3024 (atomic-change-group | 3927 (atomic-change-group |
3025 (let (word2) | 3928 (let (word2) |
3929 ;; FIXME: We first delete the two pieces of text, so markers that | |
3930 ;; used to point to after the text end up pointing to before it :-( | |
3026 (setq word2 (delete-and-extract-region (car pos2) (cdr pos2))) | 3931 (setq word2 (delete-and-extract-region (car pos2) (cdr pos2))) |
3027 (goto-char (car pos2)) | 3932 (goto-char (car pos2)) |
3028 (insert (delete-and-extract-region (car pos1) (cdr pos1))) | 3933 (insert (delete-and-extract-region (car pos1) (cdr pos1))) |
3029 (goto-char (car pos1)) | 3934 (goto-char (car pos1)) |
3030 (insert word2)))) | 3935 (insert word2)))) |
3031 | 3936 |
3032 (defun backward-word (arg) | 3937 (defun backward-word (&optional arg) |
3033 "Move backward until encountering the beginning of a word. | 3938 "Move backward until encountering the beginning of a word. |
3034 With argument, do this that many times." | 3939 With argument, do this that many times." |
3035 (interactive "p") | 3940 (interactive "p") |
3036 (forward-word (- arg))) | 3941 (forward-word (- (or arg 1)))) |
3037 | 3942 |
3038 (defun mark-word (arg) | 3943 (defun mark-word (&optional arg allow-extend) |
3039 "Set mark arg words away from point. | 3944 "Set mark ARG words away from point. |
3040 If this command is repeated, it marks the next ARG words after the ones | 3945 The place mark goes is the same place \\[forward-word] would |
3041 already marked." | 3946 move to with the same argument. |
3042 (interactive "p") | 3947 Interactively, if this command is repeated |
3043 (cond ((and (eq last-command this-command) (mark t)) | 3948 or (in Transient Mark mode) if the mark is active, |
3949 it marks the next ARG words after the ones already marked." | |
3950 (interactive "P\np") | |
3951 (cond ((and allow-extend | |
3952 (or (and (eq last-command this-command) (mark t)) | |
3953 (and transient-mark-mode mark-active))) | |
3954 (setq arg (if arg (prefix-numeric-value arg) | |
3955 (if (< (mark) (point)) -1 1))) | |
3044 (set-mark | 3956 (set-mark |
3045 (save-excursion | 3957 (save-excursion |
3046 (goto-char (mark)) | 3958 (goto-char (mark)) |
3047 (forward-word arg) | 3959 (forward-word arg) |
3048 (point)))) | 3960 (point)))) |
3049 (t | 3961 (t |
3050 (push-mark | 3962 (push-mark |
3051 (save-excursion | 3963 (save-excursion |
3052 (forward-word arg) | 3964 (forward-word (prefix-numeric-value arg)) |
3053 (point)) | 3965 (point)) |
3054 nil t)))) | 3966 nil t)))) |
3055 | 3967 |
3056 (defun kill-word (arg) | 3968 (defun kill-word (arg) |
3057 "Kill characters forward until encountering the end of a word. | 3969 "Kill characters forward until encountering the end of a word. |
3063 "Kill characters backward until encountering the end of a word. | 3975 "Kill characters backward until encountering the end of a word. |
3064 With argument, do this that many times." | 3976 With argument, do this that many times." |
3065 (interactive "p") | 3977 (interactive "p") |
3066 (kill-word (- arg))) | 3978 (kill-word (- arg))) |
3067 | 3979 |
3068 (defun current-word (&optional strict) | 3980 (defun current-word (&optional strict really-word) |
3069 "Return the word point is on (or a nearby word) as a string. | 3981 "Return the symbol or word that point is on (or a nearby one) as a string. |
3982 The return value includes no text properties. | |
3070 If optional arg STRICT is non-nil, return nil unless point is within | 3983 If optional arg STRICT is non-nil, return nil unless point is within |
3071 or adjacent to a word." | 3984 or adjacent to a symbol or word. In all cases the value can be nil |
3985 if there is no word nearby. | |
3986 The function, belying its name, normally finds a symbol. | |
3987 If optional arg REALLY-WORD is non-nil, it finds just a word." | |
3072 (save-excursion | 3988 (save-excursion |
3073 (let ((oldpoint (point)) (start (point)) (end (point))) | 3989 (let* ((oldpoint (point)) (start (point)) (end (point)) |
3074 (skip-syntax-backward "w_") (setq start (point)) | 3990 (syntaxes (if really-word "w" "w_")) |
3991 (not-syntaxes (concat "^" syntaxes))) | |
3992 (skip-syntax-backward syntaxes) (setq start (point)) | |
3075 (goto-char oldpoint) | 3993 (goto-char oldpoint) |
3076 (skip-syntax-forward "w_") (setq end (point)) | 3994 (skip-syntax-forward syntaxes) (setq end (point)) |
3077 (if (and (eq start oldpoint) (eq end oldpoint)) | 3995 (when (and (eq start oldpoint) (eq end oldpoint) |
3078 ;; Point is neither within nor adjacent to a word. | 3996 ;; Point is neither within nor adjacent to a word. |
3079 (and (not strict) | 3997 (not strict)) |
3080 (progn | 3998 ;; Look for preceding word in same line. |
3081 ;; Look for preceding word in same line. | 3999 (skip-syntax-backward not-syntaxes |
3082 (skip-syntax-backward "^w_" | 4000 (save-excursion (beginning-of-line) |
3083 (save-excursion (beginning-of-line) | 4001 (point))) |
3084 (point))) | 4002 (if (bolp) |
3085 (if (bolp) | 4003 ;; No preceding word in same line. |
3086 ;; No preceding word in same line. | 4004 ;; Look for following word in same line. |
3087 ;; Look for following word in same line. | 4005 (progn |
3088 (progn | 4006 (skip-syntax-forward not-syntaxes |
3089 (skip-syntax-forward "^w_" | 4007 (save-excursion (end-of-line) |
3090 (save-excursion (end-of-line) | 4008 (point))) |
3091 (point))) | 4009 (setq start (point)) |
3092 (setq start (point)) | 4010 (skip-syntax-forward syntaxes) |
3093 (skip-syntax-forward "w_") | 4011 (setq end (point))) |
3094 (setq end (point))) | 4012 (setq end (point)) |
3095 (setq end (point)) | 4013 (skip-syntax-backward syntaxes) |
3096 (skip-syntax-backward "w_") | 4014 (setq start (point)))) |
3097 (setq start (point))) | 4015 ;; If we found something nonempty, return it as a string. |
3098 (buffer-substring-no-properties start end))) | 4016 (unless (= start end) |
3099 (buffer-substring-no-properties start end))))) | 4017 (buffer-substring-no-properties start end))))) |
3100 | 4018 |
3101 (defcustom fill-prefix nil | 4019 (defcustom fill-prefix nil |
3102 "*String for filling to insert at front of new line, or nil for none." | 4020 "*String for filling to insert at front of new line, or nil for none." |
3103 :type '(choice (const :tag "None" nil) | 4021 :type '(choice (const :tag "None" nil) |
3114 (defvar comment-line-break-function 'comment-indent-new-line | 4032 (defvar comment-line-break-function 'comment-indent-new-line |
3115 "*Mode-specific function which line breaks and continues a comment. | 4033 "*Mode-specific function which line breaks and continues a comment. |
3116 | 4034 |
3117 This function is only called during auto-filling of a comment section. | 4035 This function is only called during auto-filling of a comment section. |
3118 The function should take a single optional argument, which is a flag | 4036 The function should take a single optional argument, which is a flag |
3119 indicating whether it should use soft newlines. | 4037 indicating whether it should use soft newlines.") |
3120 | |
3121 Setting this variable automatically makes it local to the current buffer.") | |
3122 | 4038 |
3123 ;; This function is used as the auto-fill-function of a buffer | 4039 ;; This function is used as the auto-fill-function of a buffer |
3124 ;; when Auto-Fill mode is enabled. | 4040 ;; when Auto-Fill mode is enabled. |
3125 ;; It returns t if it really did any work. | 4041 ;; It returns t if it really did any work. |
3126 ;; (Actually some major modes use a different auto-fill function, | 4042 ;; (Actually some major modes use a different auto-fill function, |
3127 ;; but this one is the default one.) | 4043 ;; but this one is the default one.) |
3128 (defun do-auto-fill () | 4044 (defun do-auto-fill () |
3129 (let (fc justify bol give-up | 4045 (let (fc justify give-up |
3130 (fill-prefix fill-prefix)) | 4046 (fill-prefix fill-prefix)) |
3131 (if (or (not (setq justify (current-justification))) | 4047 (if (or (not (setq justify (current-justification))) |
3132 (null (setq fc (current-fill-column))) | 4048 (null (setq fc (current-fill-column))) |
3133 (and (eq justify 'left) | 4049 (and (eq justify 'left) |
3134 (<= (current-column) fc)) | 4050 (<= (current-column) fc)) |
3135 (save-excursion (beginning-of-line) | 4051 (and auto-fill-inhibit-regexp |
3136 (setq bol (point)) | 4052 (save-excursion (beginning-of-line) |
3137 (and auto-fill-inhibit-regexp | |
3138 (looking-at auto-fill-inhibit-regexp)))) | 4053 (looking-at auto-fill-inhibit-regexp)))) |
3139 nil ;; Auto-filling not required | 4054 nil ;; Auto-filling not required |
3140 (if (memq justify '(full center right)) | 4055 (if (memq justify '(full center right)) |
3141 (save-excursion (unjustify-current-line))) | 4056 (save-excursion (unjustify-current-line))) |
3142 | 4057 |
3155 | 4070 |
3156 (while (and (not give-up) (> (current-column) fc)) | 4071 (while (and (not give-up) (> (current-column) fc)) |
3157 ;; Determine where to split the line. | 4072 ;; Determine where to split the line. |
3158 (let* (after-prefix | 4073 (let* (after-prefix |
3159 (fill-point | 4074 (fill-point |
3160 (let ((opoint (point))) | 4075 (save-excursion |
3161 (save-excursion | 4076 (beginning-of-line) |
3162 (beginning-of-line) | 4077 (setq after-prefix (point)) |
3163 (setq after-prefix (point)) | 4078 (and fill-prefix |
3164 (and fill-prefix | 4079 (looking-at (regexp-quote fill-prefix)) |
3165 (looking-at (regexp-quote fill-prefix)) | 4080 (setq after-prefix (match-end 0))) |
3166 (setq after-prefix (match-end 0))) | 4081 (move-to-column (1+ fc)) |
3167 (move-to-column (1+ fc)) | 4082 (fill-move-to-break-point after-prefix) |
3168 (fill-move-to-break-point after-prefix) | 4083 (point)))) |
3169 (point))))) | |
3170 | 4084 |
3171 ;; See whether the place we found is any good. | 4085 ;; See whether the place we found is any good. |
3172 (if (save-excursion | 4086 (if (save-excursion |
3173 (goto-char fill-point) | 4087 (goto-char fill-point) |
3174 (or (bolp) | 4088 (or (bolp) |
3215 | 4129 |
3216 (defvar normal-auto-fill-function 'do-auto-fill | 4130 (defvar normal-auto-fill-function 'do-auto-fill |
3217 "The function to use for `auto-fill-function' if Auto Fill mode is turned on. | 4131 "The function to use for `auto-fill-function' if Auto Fill mode is turned on. |
3218 Some major modes set this.") | 4132 Some major modes set this.") |
3219 | 4133 |
4134 (put 'auto-fill-function :minor-mode-function 'auto-fill-mode) | |
3220 ;; FIXME: turn into a proper minor mode. | 4135 ;; FIXME: turn into a proper minor mode. |
3221 ;; Add a global minor mode version of it. | 4136 ;; Add a global minor mode version of it. |
3222 (defun auto-fill-mode (&optional arg) | 4137 (defun auto-fill-mode (&optional arg) |
3223 "Toggle Auto Fill mode. | 4138 "Toggle Auto Fill mode. |
3224 With arg, turn Auto Fill mode on if and only if arg is positive. | 4139 With arg, turn Auto Fill mode on if and only if arg is positive. |
3338 with the character typed. | 4253 with the character typed. |
3339 \\[quoted-insert] replaces the text at the cursor, just as ordinary | 4254 \\[quoted-insert] replaces the text at the cursor, just as ordinary |
3340 typing characters do. | 4255 typing characters do. |
3341 | 4256 |
3342 Note that binary overwrite mode is not its own minor mode; it is a | 4257 Note that binary overwrite mode is not its own minor mode; it is a |
3343 specialization of overwrite-mode, entered by setting the | 4258 specialization of overwrite mode, entered by setting the |
3344 `overwrite-mode' variable to `overwrite-mode-binary'." | 4259 `overwrite-mode' variable to `overwrite-mode-binary'." |
3345 (interactive "P") | 4260 (interactive "P") |
3346 (setq overwrite-mode | 4261 (setq overwrite-mode |
3347 (if (if (null arg) | 4262 (if (if (null arg) |
3348 (not (eq overwrite-mode 'overwrite-mode-binary)) | 4263 (not (eq overwrite-mode 'overwrite-mode-binary)) |
3357 in the mode line. | 4272 in the mode line. |
3358 | 4273 |
3359 Line numbers do not appear for very large buffers and buffers | 4274 Line numbers do not appear for very large buffers and buffers |
3360 with very long lines; see variables `line-number-display-limit' | 4275 with very long lines; see variables `line-number-display-limit' |
3361 and `line-number-display-limit-width'." | 4276 and `line-number-display-limit-width'." |
3362 :init-value t :global t :group 'editing-basics :require nil) | 4277 :init-value t :global t :group 'editing-basics) |
3363 | 4278 |
3364 (define-minor-mode column-number-mode | 4279 (define-minor-mode column-number-mode |
3365 "Toggle Column Number mode. | 4280 "Toggle Column Number mode. |
3366 With arg, turn Column Number mode on iff arg is positive. | 4281 With arg, turn Column Number mode on iff arg is positive. |
3367 When Column Number mode is enabled, the column number appears | 4282 When Column Number mode is enabled, the column number appears |
3368 in the mode line." | 4283 in the mode line." |
3369 :global t :group 'editing-basics :require nil) | 4284 :global t :group 'editing-basics) |
4285 | |
4286 (define-minor-mode size-indication-mode | |
4287 "Toggle Size Indication mode. | |
4288 With arg, turn Size Indication mode on iff arg is positive. When | |
4289 Size Indication mode is enabled, the size of the accessible part | |
4290 of the buffer appears in the mode line." | |
4291 :global t :group 'editing-basics) | |
3370 | 4292 |
3371 (defgroup paren-blinking nil | 4293 (defgroup paren-blinking nil |
3372 "Blinking matching of parens and expressions." | 4294 "Blinking matching of parens and expressions." |
3373 :prefix "blink-matching-" | 4295 :prefix "blink-matching-" |
3374 :group 'paren-matching) | 4296 :group 'paren-matching) |
3379 :group 'paren-blinking) | 4301 :group 'paren-blinking) |
3380 | 4302 |
3381 (defcustom blink-matching-paren-on-screen t | 4303 (defcustom blink-matching-paren-on-screen t |
3382 "*Non-nil means show matching open-paren when it is on screen. | 4304 "*Non-nil means show matching open-paren when it is on screen. |
3383 If nil, means don't show it (but the open-paren can still be shown | 4305 If nil, means don't show it (but the open-paren can still be shown |
3384 when it is off screen)." | 4306 when it is off screen). |
4307 | |
4308 This variable has no effect if `blink-matching-paren' is nil. | |
4309 \(In that case, the open-paren is never shown.) | |
4310 It is also ignored if `show-paren-mode' is enabled." | |
3385 :type 'boolean | 4311 :type 'boolean |
3386 :group 'paren-blinking) | 4312 :group 'paren-blinking) |
3387 | 4313 |
3388 (defcustom blink-matching-paren-distance (* 25 1024) | 4314 (defcustom blink-matching-paren-distance (* 25 1024) |
3389 "*If non-nil, is maximum distance to search for matching open-paren." | 4315 "*If non-nil, maximum distance to search backwards for matching open-paren. |
3390 :type 'integer | 4316 If nil, search stops at the beginning of the accessible portion of the buffer." |
4317 :type '(choice (const nil) integer) | |
3391 :group 'paren-blinking) | 4318 :group 'paren-blinking) |
3392 | 4319 |
3393 (defcustom blink-matching-delay 1 | 4320 (defcustom blink-matching-delay 1 |
3394 "*Time in seconds to delay after showing a matching paren." | 4321 "*Time in seconds to delay after showing a matching paren." |
3395 :type 'number | 4322 :type 'number |
3401 :group 'paren-blinking) | 4328 :group 'paren-blinking) |
3402 | 4329 |
3403 (defun blink-matching-open () | 4330 (defun blink-matching-open () |
3404 "Move cursor momentarily to the beginning of the sexp before point." | 4331 "Move cursor momentarily to the beginning of the sexp before point." |
3405 (interactive) | 4332 (interactive) |
3406 (and (> (point) (1+ (point-min))) | 4333 (when (and (> (point) (point-min)) |
3407 blink-matching-paren | 4334 blink-matching-paren |
3408 ;; Verify an even number of quoting characters precede the close. | 4335 ;; Verify an even number of quoting characters precede the close. |
3409 (= 1 (logand 1 (- (point) | 4336 (= 1 (logand 1 (- (point) |
3410 (save-excursion | 4337 (save-excursion |
3411 (forward-char -1) | 4338 (forward-char -1) |
3412 (skip-syntax-backward "/\\") | 4339 (skip-syntax-backward "/\\") |
3413 (point))))) | 4340 (point)))))) |
3414 (let* ((oldpos (point)) | 4341 (let* ((oldpos (point)) |
3415 (blinkpos) | 4342 blinkpos |
3416 (mismatch)) | 4343 message-log-max ; Don't log messages about paren matching. |
3417 (save-excursion | 4344 matching-paren |
3418 (save-restriction | 4345 open-paren-line-string) |
3419 (if blink-matching-paren-distance | 4346 (save-excursion |
3420 (narrow-to-region (max (point-min) | 4347 (save-restriction |
3421 (- (point) blink-matching-paren-distance)) | 4348 (if blink-matching-paren-distance |
3422 oldpos)) | 4349 (narrow-to-region (max (point-min) |
3423 (condition-case () | 4350 (- (point) blink-matching-paren-distance)) |
3424 (let ((parse-sexp-ignore-comments | 4351 oldpos)) |
3425 (and parse-sexp-ignore-comments | 4352 (condition-case () |
3426 (not blink-matching-paren-dont-ignore-comments)))) | 4353 (let ((parse-sexp-ignore-comments |
3427 (setq blinkpos (scan-sexps oldpos -1))) | 4354 (and parse-sexp-ignore-comments |
3428 (error nil))) | 4355 (not blink-matching-paren-dont-ignore-comments)))) |
3429 (and blinkpos | 4356 (setq blinkpos (scan-sexps oldpos -1))) |
3430 (/= (char-syntax (char-after blinkpos)) | 4357 (error nil))) |
3431 ?\$) | 4358 (and blinkpos |
3432 (setq mismatch | 4359 ;; Not syntax '$'. |
3433 (or (null (matching-paren (char-after blinkpos))) | 4360 (not (eq (syntax-class (syntax-after blinkpos)) 8)) |
3434 (/= (char-after (1- oldpos)) | 4361 (setq matching-paren |
3435 (matching-paren (char-after blinkpos)))))) | 4362 (let ((syntax (syntax-after blinkpos))) |
3436 (if mismatch (setq blinkpos nil)) | 4363 (and (consp syntax) |
3437 (if blinkpos | 4364 (eq (syntax-class syntax) 4) |
3438 ;; Don't log messages about paren matching. | 4365 (cdr syntax))))) |
3439 (let (message-log-max) | 4366 (cond |
3440 (goto-char blinkpos) | 4367 ((not (or (eq matching-paren (char-before oldpos)) |
3441 (if (pos-visible-in-window-p) | 4368 ;; The cdr might hold a new paren-class info rather than |
3442 (and blink-matching-paren-on-screen | 4369 ;; a matching-char info, in which case the two CDRs |
3443 (sit-for blink-matching-delay)) | 4370 ;; should match. |
3444 (goto-char blinkpos) | 4371 (eq matching-paren (cdr (syntax-after (1- oldpos)))))) |
3445 (message | 4372 (message "Mismatched parentheses")) |
3446 "Matches %s" | 4373 ((not blinkpos) |
3447 ;; Show what precedes the open in its line, if anything. | 4374 (if (not blink-matching-paren-distance) |
3448 (if (save-excursion | 4375 (message "Unmatched parenthesis"))) |
3449 (skip-chars-backward " \t") | 4376 ((pos-visible-in-window-p blinkpos) |
3450 (not (bolp))) | 4377 ;; Matching open within window, temporarily move to blinkpos but only |
3451 (buffer-substring (progn (beginning-of-line) (point)) | 4378 ;; if `blink-matching-paren-on-screen' is non-nil. |
3452 (1+ blinkpos)) | 4379 (and blink-matching-paren-on-screen |
3453 ;; Show what follows the open in its line, if anything. | 4380 (not show-paren-mode) |
3454 (if (save-excursion | 4381 (save-excursion |
3455 (forward-char 1) | 4382 (goto-char blinkpos) |
3456 (skip-chars-forward " \t") | 4383 (sit-for blink-matching-delay)))) |
3457 (not (eolp))) | 4384 (t |
3458 (buffer-substring blinkpos | 4385 (save-excursion |
3459 (progn (end-of-line) (point))) | 4386 (goto-char blinkpos) |
3460 ;; Otherwise show the previous nonblank line, | 4387 (setq open-paren-line-string |
3461 ;; if there is one. | 4388 ;; Show what precedes the open in its line, if anything. |
3462 (if (save-excursion | 4389 (if (save-excursion |
3463 (skip-chars-backward "\n \t") | 4390 (skip-chars-backward " \t") |
3464 (not (bobp))) | 4391 (not (bolp))) |
3465 (concat | 4392 (buffer-substring (line-beginning-position) |
3466 (buffer-substring (progn | 4393 (1+ blinkpos)) |
4394 ;; Show what follows the open in its line, if anything. | |
4395 (if (save-excursion | |
4396 (forward-char 1) | |
4397 (skip-chars-forward " \t") | |
4398 (not (eolp))) | |
4399 (buffer-substring blinkpos | |
4400 (line-end-position)) | |
4401 ;; Otherwise show the previous nonblank line, | |
4402 ;; if there is one. | |
4403 (if (save-excursion | |
4404 (skip-chars-backward "\n \t") | |
4405 (not (bobp))) | |
4406 (concat | |
4407 (buffer-substring (progn | |
3467 (skip-chars-backward "\n \t") | 4408 (skip-chars-backward "\n \t") |
3468 (beginning-of-line) | 4409 (line-beginning-position)) |
3469 (point)) | 4410 (progn (end-of-line) |
3470 (progn (end-of-line) | 4411 (skip-chars-backward " \t") |
3471 (skip-chars-backward " \t") | 4412 (point))) |
3472 (point))) | 4413 ;; Replace the newline and other whitespace with `...'. |
3473 ;; Replace the newline and other whitespace with `...'. | 4414 "..." |
3474 "..." | 4415 (buffer-substring blinkpos (1+ blinkpos))) |
3475 (buffer-substring blinkpos (1+ blinkpos))) | 4416 ;; There is nothing to show except the char itself. |
3476 ;; There is nothing to show except the char itself. | 4417 (buffer-substring blinkpos (1+ blinkpos))))))) |
3477 (buffer-substring blinkpos (1+ blinkpos)))))))) | 4418 (message "Matches %s" |
3478 (cond (mismatch | 4419 (substring-no-properties open-paren-line-string)))))))) |
3479 (message "Mismatched parentheses")) | |
3480 ((not blink-matching-paren-distance) | |
3481 (message "Unmatched parenthesis")))))))) | |
3482 | 4420 |
3483 ;Turned off because it makes dbx bomb out. | 4421 ;Turned off because it makes dbx bomb out. |
3484 (setq blink-paren-function 'blink-matching-open) | 4422 (setq blink-paren-function 'blink-matching-open) |
3485 | 4423 |
3486 ;; This executes C-g typed while Emacs is waiting for a command. | 4424 ;; This executes C-g typed while Emacs is waiting for a command. |
3490 "Signal a `quit' condition. | 4428 "Signal a `quit' condition. |
3491 During execution of Lisp code, this character causes a quit directly. | 4429 During execution of Lisp code, this character causes a quit directly. |
3492 At top-level, as an editor command, this simply beeps." | 4430 At top-level, as an editor command, this simply beeps." |
3493 (interactive) | 4431 (interactive) |
3494 (deactivate-mark) | 4432 (deactivate-mark) |
4433 (if (fboundp 'kmacro-keyboard-quit) | |
4434 (kmacro-keyboard-quit)) | |
3495 (setq defining-kbd-macro nil) | 4435 (setq defining-kbd-macro nil) |
3496 (signal 'quit nil)) | 4436 (signal 'quit nil)) |
3497 | |
3498 (define-key global-map "\C-g" 'keyboard-quit) | |
3499 | 4437 |
3500 (defvar buffer-quit-function nil | 4438 (defvar buffer-quit-function nil |
3501 "Function to call to \"quit\" the current buffer, or nil if none. | 4439 "Function to call to \"quit\" the current buffer, or nil if none. |
3502 \\[keyboard-escape-quit] calls this function when its more local actions | 4440 \\[keyboard-escape-quit] calls this function when its more local actions |
3503 \(such as cancelling a prefix argument, minibuffer or region) do not apply.") | 4441 \(such as cancelling a prefix argument, minibuffer or region) do not apply.") |
3513 (cond ((eq last-command 'mode-exited) nil) | 4451 (cond ((eq last-command 'mode-exited) nil) |
3514 ((> (minibuffer-depth) 0) | 4452 ((> (minibuffer-depth) 0) |
3515 (abort-recursive-edit)) | 4453 (abort-recursive-edit)) |
3516 (current-prefix-arg | 4454 (current-prefix-arg |
3517 nil) | 4455 nil) |
3518 ((and transient-mark-mode | 4456 ((and transient-mark-mode mark-active) |
3519 mark-active) | |
3520 (deactivate-mark)) | 4457 (deactivate-mark)) |
3521 ((> (recursion-depth) 0) | 4458 ((> (recursion-depth) 0) |
3522 (exit-recursive-edit)) | 4459 (exit-recursive-edit)) |
3523 (buffer-quit-function | 4460 (buffer-quit-function |
3524 (funcall buffer-quit-function)) | 4461 (funcall buffer-quit-function)) |
3538 (if device | 4475 (if device |
3539 (plist-put sound :device device)) | 4476 (plist-put sound :device device)) |
3540 (push 'sound sound) | 4477 (push 'sound sound) |
3541 (play-sound sound))) | 4478 (play-sound sound))) |
3542 | 4479 |
3543 (define-key global-map "\e\e\e" 'keyboard-escape-quit) | 4480 |
3544 | |
3545 (defcustom read-mail-command 'rmail | 4481 (defcustom read-mail-command 'rmail |
3546 "*Your preference for a mail reading package. | 4482 "*Your preference for a mail reading package. |
3547 This is used by some keybindings which support reading mail. | 4483 This is used by some keybindings which support reading mail. |
3548 See also `mail-user-agent' concerning sending mail." | 4484 See also `mail-user-agent' concerning sending mail." |
3549 :type '(choice (function-item rmail) | 4485 :type '(choice (function-item rmail) |
3609 (let ((special-display-buffer-names nil) | 4545 (let ((special-display-buffer-names nil) |
3610 (special-display-regexps nil) | 4546 (special-display-regexps nil) |
3611 (same-window-buffer-names nil) | 4547 (same-window-buffer-names nil) |
3612 (same-window-regexps nil)) | 4548 (same-window-regexps nil)) |
3613 (funcall switch-function "*mail*"))) | 4549 (funcall switch-function "*mail*"))) |
3614 (let ((cc (cdr (assoc-ignore-case "cc" other-headers))) | 4550 (let ((cc (cdr (assoc-string "cc" other-headers t))) |
3615 (in-reply-to (cdr (assoc-ignore-case "in-reply-to" other-headers))) | 4551 (in-reply-to (cdr (assoc-string "in-reply-to" other-headers t))) |
3616 (body (cdr (assoc-ignore-case "body" other-headers)))) | 4552 (body (cdr (assoc-string "body" other-headers t)))) |
3617 (or (mail continue to subject in-reply-to cc yank-action send-actions) | 4553 (or (mail continue to subject in-reply-to cc yank-action send-actions) |
3618 continue | 4554 continue |
3619 (error "Message aborted")) | 4555 (error "Message aborted")) |
3620 (save-excursion | 4556 (save-excursion |
3621 (rfc822-goto-eoh) | 4557 (rfc822-goto-eoh) |
3622 (while other-headers | 4558 (while other-headers |
3623 (unless (member-ignore-case (car (car other-headers)) | 4559 (unless (member-ignore-case (car (car other-headers)) |
3624 '("in-reply-to" "cc" "body")) | 4560 '("in-reply-to" "cc" "body")) |
3625 (insert (car (car other-headers)) ": " | 4561 (insert (car (car other-headers)) ": " |
3626 (cdr (car other-headers)) "\n")) | 4562 (cdr (car other-headers)) |
4563 (if use-hard-newlines hard-newline "\n"))) | |
3627 (setq other-headers (cdr other-headers))) | 4564 (setq other-headers (cdr other-headers))) |
3628 (when body | 4565 (when body |
3629 (forward-line 1) | 4566 (forward-line 1) |
3630 (insert body)) | 4567 (insert body)) |
3631 t))) | 4568 t))) |
3632 | |
3633 (define-mail-user-agent 'mh-e-user-agent | |
3634 'mh-smail-batch 'mh-send-letter 'mh-fully-kill-draft | |
3635 'mh-before-send-letter-hook) | |
3636 | 4569 |
3637 (defun compose-mail (&optional to subject other-headers continue | 4570 (defun compose-mail (&optional to subject other-headers continue |
3638 switch-function yank-action send-actions) | 4571 switch-function yank-action send-actions) |
3639 "Start composing a mail message to send. | 4572 "Start composing a mail message to send. |
3640 This uses the user's chosen mail composition package | 4573 This uses the user's chosen mail composition package |
3681 "Like \\[compose-mail], but edit the outgoing message in another frame." | 4614 "Like \\[compose-mail], but edit the outgoing message in another frame." |
3682 (interactive | 4615 (interactive |
3683 (list nil nil nil current-prefix-arg)) | 4616 (list nil nil nil current-prefix-arg)) |
3684 (compose-mail to subject other-headers continue | 4617 (compose-mail to subject other-headers continue |
3685 'switch-to-buffer-other-frame yank-action send-actions)) | 4618 'switch-to-buffer-other-frame yank-action send-actions)) |
3686 | 4619 |
3687 (defvar set-variable-value-history nil | 4620 (defvar set-variable-value-history nil |
3688 "History of values entered with `set-variable'.") | 4621 "History of values entered with `set-variable'.") |
3689 | 4622 |
3690 (defun set-variable (var val &optional make-local) | 4623 (defun set-variable (variable value &optional make-local) |
3691 "Set VARIABLE to VALUE. VALUE is a Lisp object. | 4624 "Set VARIABLE to VALUE. VALUE is a Lisp object. |
3692 When using this interactively, enter a Lisp object for VALUE. | 4625 VARIABLE should be a user option variable name, a Lisp variable |
3693 If you want VALUE to be a string, you must surround it with doublequotes. | 4626 meant to be customized by users. You should enter VALUE in Lisp syntax, |
4627 so if you want VALUE to be a string, you must surround it with doublequotes. | |
3694 VALUE is used literally, not evaluated. | 4628 VALUE is used literally, not evaluated. |
3695 | 4629 |
3696 If VARIABLE has a `variable-interactive' property, that is used as if | 4630 If VARIABLE has a `variable-interactive' property, that is used as if |
3697 it were the arg to `interactive' (which see) to interactively read VALUE. | 4631 it were the arg to `interactive' (which see) to interactively read VALUE. |
3698 | 4632 |
3700 in the definition is used to check that VALUE is valid. | 4634 in the definition is used to check that VALUE is valid. |
3701 | 4635 |
3702 With a prefix argument, set VARIABLE to VALUE buffer-locally." | 4636 With a prefix argument, set VARIABLE to VALUE buffer-locally." |
3703 (interactive | 4637 (interactive |
3704 (let* ((default-var (variable-at-point)) | 4638 (let* ((default-var (variable-at-point)) |
3705 (var (if (symbolp default-var) | 4639 (var (if (user-variable-p default-var) |
3706 (read-variable (format "Set variable (default %s): " default-var) | 4640 (read-variable (format "Set variable (default %s): " default-var) |
3707 default-var) | 4641 default-var) |
3708 (read-variable "Set variable: "))) | 4642 (read-variable "Set variable: "))) |
3709 (minibuffer-help-form '(describe-variable var)) | 4643 (minibuffer-help-form '(describe-variable var)) |
3710 (prop (get var 'variable-interactive)) | 4644 (prop (get var 'variable-interactive)) |
3711 (prompt (format "Set %s%s to value: " var | 4645 (obsolete (car (get var 'byte-obsolete-variable))) |
3712 (cond ((local-variable-p var) | 4646 (prompt (format "Set %s %s to value: " var |
3713 " (buffer-local)") | 4647 (cond ((local-variable-p var) |
3714 ((or current-prefix-arg | 4648 "(buffer-local)") |
3715 (local-variable-if-set-p var)) | 4649 ((or current-prefix-arg |
3716 " buffer-locally") | 4650 (local-variable-if-set-p var)) |
3717 (t " globally")))) | 4651 "buffer-locally") |
3718 (val (if prop | 4652 (t "globally")))) |
3719 ;; Use VAR's `variable-interactive' property | 4653 (val (progn |
3720 ;; as an interactive spec for prompting. | 4654 (when obsolete |
3721 (call-interactively `(lambda (arg) | 4655 (message (concat "`%S' is obsolete; " |
3722 (interactive ,prop) | 4656 (if (symbolp obsolete) "use `%S' instead" "%s")) |
3723 arg)) | 4657 var obsolete) |
3724 (read | 4658 (sit-for 3)) |
3725 (read-string prompt nil | 4659 (if prop |
3726 'set-variable-value-history))))) | 4660 ;; Use VAR's `variable-interactive' property |
3727 (list var val current-prefix-arg))) | 4661 ;; as an interactive spec for prompting. |
3728 | 4662 (call-interactively `(lambda (arg) |
3729 (and (custom-variable-p var) | 4663 (interactive ,prop) |
3730 (not (get var 'custom-type)) | 4664 arg)) |
3731 (custom-load-symbol var)) | 4665 (read |
3732 (let ((type (get var 'custom-type))) | 4666 (read-string prompt nil |
4667 'set-variable-value-history | |
4668 (format "%S" (symbol-value var)))))))) | |
4669 (list var val current-prefix-arg))) | |
4670 | |
4671 (and (custom-variable-p variable) | |
4672 (not (get variable 'custom-type)) | |
4673 (custom-load-symbol variable)) | |
4674 (let ((type (get variable 'custom-type))) | |
3733 (when type | 4675 (when type |
3734 ;; Match with custom type. | 4676 ;; Match with custom type. |
3735 (require 'cus-edit) | 4677 (require 'cus-edit) |
3736 (setq type (widget-convert type)) | 4678 (setq type (widget-convert type)) |
3737 (unless (widget-apply type :match val) | 4679 (unless (widget-apply type :match value) |
3738 (error "Value `%S' does not match type %S of %S" | 4680 (error "Value `%S' does not match type %S of %S" |
3739 val (car type) var)))) | 4681 value (car type) variable)))) |
3740 | 4682 |
3741 (if make-local | 4683 (if make-local |
3742 (make-local-variable var)) | 4684 (make-local-variable variable)) |
3743 | 4685 |
3744 (set var val) | 4686 (set variable value) |
3745 | 4687 |
3746 ;; Force a thorough redisplay for the case that the variable | 4688 ;; Force a thorough redisplay for the case that the variable |
3747 ;; has an effect on the display, like `tab-width' has. | 4689 ;; has an effect on the display, like `tab-width' has. |
3748 (force-mode-line-update)) | 4690 (force-mode-line-update)) |
3749 | 4691 |
3750 ;; Define the major mode for lists of completions. | 4692 ;; Define the major mode for lists of completions. |
3751 | 4693 |
3752 (defvar completion-list-mode-map nil | 4694 (defvar completion-list-mode-map nil |
3753 "Local map for completion list buffers.") | 4695 "Local map for completion list buffers.") |
3754 (or completion-list-mode-map | 4696 (or completion-list-mode-map |
3755 (let ((map (make-sparse-keymap))) | 4697 (let ((map (make-sparse-keymap))) |
3756 (define-key map [mouse-2] 'mouse-choose-completion) | 4698 (define-key map [mouse-2] 'mouse-choose-completion) |
4699 (define-key map [follow-link] 'mouse-face) | |
3757 (define-key map [down-mouse-2] nil) | 4700 (define-key map [down-mouse-2] nil) |
3758 (define-key map "\C-m" 'choose-completion) | 4701 (define-key map "\C-m" 'choose-completion) |
3759 (define-key map "\e\e\e" 'delete-completion-window) | 4702 (define-key map "\e\e\e" 'delete-completion-window) |
3760 (define-key map [left] 'previous-completion) | 4703 (define-key map [left] 'previous-completion) |
3761 (define-key map [right] 'next-completion) | 4704 (define-key map [right] 'next-completion) |
3837 (setq end (1- (point)) beg (point))) | 4780 (setq end (1- (point)) beg (point))) |
3838 (if (null beg) | 4781 (if (null beg) |
3839 (error "No completion here")) | 4782 (error "No completion here")) |
3840 (setq beg (previous-single-property-change beg 'mouse-face)) | 4783 (setq beg (previous-single-property-change beg 'mouse-face)) |
3841 (setq end (or (next-single-property-change end 'mouse-face) (point-max))) | 4784 (setq end (or (next-single-property-change end 'mouse-face) (point-max))) |
3842 (setq completion (buffer-substring beg end)) | 4785 (setq completion (buffer-substring-no-properties beg end)) |
3843 (let ((owindow (selected-window))) | 4786 (let ((owindow (selected-window))) |
3844 (if (and (one-window-p t 'selected-frame) | 4787 (if (and (one-window-p t 'selected-frame) |
3845 (window-dedicated-p (selected-window))) | 4788 (window-dedicated-p (selected-window))) |
3846 ;; This is a special buffer's frame | 4789 ;; This is a special buffer's frame |
3847 (iconify-frame (selected-frame)) | 4790 (iconify-frame (selected-frame)) |
3896 | 4839 |
3897 ;; If BUFFER is the minibuffer, exit the minibuffer | 4840 ;; If BUFFER is the minibuffer, exit the minibuffer |
3898 ;; unless it is reading a file name and CHOICE is a directory, | 4841 ;; unless it is reading a file name and CHOICE is a directory, |
3899 ;; or completion-no-auto-exit is non-nil. | 4842 ;; or completion-no-auto-exit is non-nil. |
3900 | 4843 |
3901 (let ((buffer (or buffer completion-reference-buffer)) | 4844 (let* ((buffer (or buffer completion-reference-buffer)) |
3902 (mini-p (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" | 4845 (mini-p (minibufferp buffer))) |
3903 (buffer-name buffer)))) | |
3904 ;; If BUFFER is a minibuffer, barf unless it's the currently | 4846 ;; If BUFFER is a minibuffer, barf unless it's the currently |
3905 ;; active minibuffer. | 4847 ;; active minibuffer. |
3906 (if (and mini-p | 4848 (if (and mini-p |
3907 (or (not (active-minibuffer-window)) | 4849 (or (not (active-minibuffer-window)) |
3908 (not (equal buffer | 4850 (not (equal buffer |
3909 (window-buffer (active-minibuffer-window)))))) | 4851 (window-buffer (active-minibuffer-window)))))) |
3910 (error "Minibuffer is not active for completion") | 4852 (error "Minibuffer is not active for completion") |
4853 ;; Set buffer so buffer-local choose-completion-string-functions works. | |
4854 (set-buffer buffer) | |
3911 (unless (run-hook-with-args-until-success | 4855 (unless (run-hook-with-args-until-success |
3912 'choose-completion-string-functions | 4856 'choose-completion-string-functions |
3913 choice buffer mini-p base-size) | 4857 choice buffer mini-p base-size) |
3914 ;; Insert the completion into the buffer where it was requested. | 4858 ;; Insert the completion into the buffer where it was requested. |
3915 (set-buffer buffer) | |
3916 (if base-size | 4859 (if base-size |
3917 (delete-region (+ base-size (if mini-p | 4860 (delete-region (+ base-size (if mini-p |
3918 (minibuffer-prompt-end) | 4861 (minibuffer-prompt-end) |
3919 (point-min))) | 4862 (point-min))) |
3920 (point)) | 4863 (point)) |
3950 (use-local-map completion-list-mode-map) | 4893 (use-local-map completion-list-mode-map) |
3951 (setq mode-name "Completion List") | 4894 (setq mode-name "Completion List") |
3952 (setq major-mode 'completion-list-mode) | 4895 (setq major-mode 'completion-list-mode) |
3953 (make-local-variable 'completion-base-size) | 4896 (make-local-variable 'completion-base-size) |
3954 (setq completion-base-size nil) | 4897 (setq completion-base-size nil) |
3955 (run-hooks 'completion-list-mode-hook)) | 4898 (run-mode-hooks 'completion-list-mode-hook)) |
3956 | 4899 |
3957 (defun completion-list-mode-finish () | 4900 (defun completion-list-mode-finish () |
3958 "Finish setup of the completions buffer. | 4901 "Finish setup of the completions buffer. |
3959 Called from `temp-buffer-show-hook'." | 4902 Called from `temp-buffer-show-hook'." |
3960 (when (eq major-mode 'completion-list-mode) | 4903 (when (eq major-mode 'completion-list-mode) |
3964 | 4907 |
3965 (defvar completion-setup-hook nil | 4908 (defvar completion-setup-hook nil |
3966 "Normal hook run at the end of setting up a completion list buffer. | 4909 "Normal hook run at the end of setting up a completion list buffer. |
3967 When this hook is run, the current buffer is the one in which the | 4910 When this hook is run, the current buffer is the one in which the |
3968 command to display the completion list buffer was run. | 4911 command to display the completion list buffer was run. |
3969 The completion list buffer is available as the value of `standard-output'.") | 4912 The completion list buffer is available as the value of `standard-output'. |
4913 The common prefix substring for completion may be available as the | |
4914 value of `completion-common-substring'. See also `display-completion-list'.") | |
4915 | |
4916 | |
4917 ;; Variables and faces used in `completion-setup-function'. | |
4918 | |
4919 (defface completions-first-difference | |
4920 '((t (:inherit bold))) | |
4921 "Face put on the first uncommon character in completions in *Completions* buffer." | |
4922 :group 'completion) | |
4923 | |
4924 (defface completions-common-part | |
4925 '((t (:inherit default))) | |
4926 "Face put on the common prefix substring in completions in *Completions* buffer. | |
4927 The idea of `completions-common-part' is that you can use it to | |
4928 make the common parts less visible than normal, so that the rest | |
4929 of the differing parts is, by contrast, slightly highlighted." | |
4930 :group 'completion) | |
4931 | |
4932 ;; This is for packages that need to bind it to a non-default regexp | |
4933 ;; in order to make the first-differing character highlight work | |
4934 ;; to their liking | |
4935 (defvar completion-root-regexp "^/" | |
4936 "Regexp to use in `completion-setup-function' to find the root directory.") | |
4937 | |
4938 (defvar completion-common-substring nil | |
4939 "Common prefix substring to use in `completion-setup-function' to put faces. | |
4940 The value is set by `display-completion-list' during running `completion-setup-hook'. | |
4941 | |
4942 To put faces `completions-first-difference' and `completions-common-part' | |
4943 in the `*Completions*' buffer, the common prefix substring in completions | |
4944 is needed as a hint. (The minibuffer is a special case. The content | |
4945 of the minibuffer before point is always the common substring.)") | |
3970 | 4946 |
3971 ;; This function goes in completion-setup-hook, so that it is called | 4947 ;; This function goes in completion-setup-hook, so that it is called |
3972 ;; after the text of the completion list buffer is written. | 4948 ;; after the text of the completion list buffer is written. |
3973 | |
3974 (defun completion-setup-function () | 4949 (defun completion-setup-function () |
3975 (save-excursion | 4950 (let* ((mainbuf (current-buffer)) |
3976 (let ((mainbuf (current-buffer)) | 4951 (mbuf-contents (minibuffer-completion-contents)) |
3977 (mbuf-contents (minibuffer-contents))) | 4952 common-string-length) |
3978 ;; When reading a file name in the minibuffer, | 4953 ;; When reading a file name in the minibuffer, |
3979 ;; set default-directory in the minibuffer | 4954 ;; set default-directory in the minibuffer |
3980 ;; so it will get copied into the completion list buffer. | 4955 ;; so it will get copied into the completion list buffer. |
3981 (if minibuffer-completing-file-name | 4956 (if minibuffer-completing-file-name |
3982 (with-current-buffer mainbuf | 4957 (with-current-buffer mainbuf |
3983 (setq default-directory (file-name-directory mbuf-contents)))) | 4958 (setq default-directory (file-name-directory mbuf-contents)))) |
3984 (set-buffer standard-output) | 4959 (with-current-buffer standard-output |
3985 (completion-list-mode) | 4960 (completion-list-mode) |
3986 (make-local-variable 'completion-reference-buffer) | 4961 (set (make-local-variable 'completion-reference-buffer) mainbuf) |
3987 (setq completion-reference-buffer mainbuf) | 4962 (setq completion-base-size |
3988 (if minibuffer-completing-file-name | 4963 (cond |
3989 ;; For file name completion, | 4964 ((and (symbolp minibuffer-completion-table) |
3990 ;; use the number of chars before the start of the | 4965 (get minibuffer-completion-table 'completion-base-size-function)) |
3991 ;; last file name component. | 4966 ;; To compute base size, a function can use the global value of |
3992 (setq completion-base-size | 4967 ;; completion-common-substring or minibuffer-completion-contents. |
4968 (with-current-buffer mainbuf | |
4969 (funcall (get minibuffer-completion-table | |
4970 'completion-base-size-function)))) | |
4971 (minibuffer-completing-file-name | |
4972 ;; For file name completion, use the number of chars before | |
4973 ;; the start of the file name component at point. | |
4974 (with-current-buffer mainbuf | |
3993 (save-excursion | 4975 (save-excursion |
3994 (set-buffer mainbuf) | 4976 (skip-chars-backward completion-root-regexp) |
3995 (goto-char (point-max)) | 4977 (- (point) (minibuffer-prompt-end))))) |
3996 (skip-chars-backward "^/") | 4978 ;; Otherwise, in minibuffer, the base size is 0. |
3997 (- (point) (minibuffer-prompt-end)))) | 4979 ((minibufferp mainbuf) 0))) |
3998 ;; Otherwise, in minibuffer, the whole input is being completed. | 4980 (setq common-string-length |
3999 (save-match-data | 4981 (cond |
4000 (if (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" | 4982 (completion-common-substring |
4001 (buffer-name mainbuf)) | 4983 (length completion-common-substring)) |
4002 (setq completion-base-size 0)))) | 4984 (completion-base-size |
4985 (- (length mbuf-contents) completion-base-size)))) | |
4986 ;; Put faces on first uncommon characters and common parts. | |
4987 (when (and (integerp common-string-length) (>= common-string-length 0)) | |
4988 (let ((element-start (point-min)) | |
4989 (maxp (point-max)) | |
4990 element-common-end) | |
4991 (while (and (setq element-start | |
4992 (next-single-property-change | |
4993 element-start 'mouse-face)) | |
4994 (< (setq element-common-end | |
4995 (+ element-start common-string-length)) | |
4996 maxp)) | |
4997 (when (get-char-property element-start 'mouse-face) | |
4998 (if (and (> common-string-length 0) | |
4999 (get-char-property (1- element-common-end) 'mouse-face)) | |
5000 (put-text-property element-start element-common-end | |
5001 'font-lock-face 'completions-common-part)) | |
5002 (if (get-char-property element-common-end 'mouse-face) | |
5003 (put-text-property element-common-end (1+ element-common-end) | |
5004 'font-lock-face 'completions-first-difference)))))) | |
5005 ;; Insert help string. | |
4003 (goto-char (point-min)) | 5006 (goto-char (point-min)) |
4004 (if (display-mouse-p) | 5007 (if (display-mouse-p) |
4005 (insert (substitute-command-keys | 5008 (insert (substitute-command-keys |
4006 "Click \\[mouse-choose-completion] on a completion to select it.\n"))) | 5009 "Click \\[mouse-choose-completion] on a completion to select it.\n"))) |
4007 (insert (substitute-command-keys | 5010 (insert (substitute-command-keys |
4008 "In this buffer, type \\[choose-completion] to \ | 5011 "In this buffer, type \\[choose-completion] to \ |
4009 select the completion near point.\n\n"))))) | 5012 select the completion near point.\n\n"))))) |
4010 | 5013 |
4011 (add-hook 'completion-setup-hook 'completion-setup-function) | 5014 (add-hook 'completion-setup-hook 'completion-setup-function) |
4012 | 5015 |
4013 (define-key minibuffer-local-completion-map [prior] | 5016 (define-key minibuffer-local-completion-map [prior] 'switch-to-completions) |
4014 'switch-to-completions) | 5017 (define-key minibuffer-local-completion-map "\M-v" 'switch-to-completions) |
4015 (define-key minibuffer-local-must-match-map [prior] | |
4016 'switch-to-completions) | |
4017 (define-key minibuffer-local-completion-map "\M-v" | |
4018 'switch-to-completions) | |
4019 (define-key minibuffer-local-must-match-map "\M-v" | |
4020 'switch-to-completions) | |
4021 | 5018 |
4022 (defun switch-to-completions () | 5019 (defun switch-to-completions () |
4023 "Select the completion list window." | 5020 "Select the completion list window." |
4024 (interactive) | 5021 (interactive) |
4025 ;; Make sure we have a completions window. | 5022 ;; Make sure we have a completions window. |
4036 | 5033 |
4037 ;; These functions -- which are not commands -- each add one modifier | 5034 ;; These functions -- which are not commands -- each add one modifier |
4038 ;; to the following event. | 5035 ;; to the following event. |
4039 | 5036 |
4040 (defun event-apply-alt-modifier (ignore-prompt) | 5037 (defun event-apply-alt-modifier (ignore-prompt) |
4041 "Add the Alt modifier to the following event. | 5038 "\\<function-key-map>Add the Alt modifier to the following event. |
4042 For example, type \\[event-apply-alt-modifier] & to enter Alt-&." | 5039 For example, type \\[event-apply-alt-modifier] & to enter Alt-&." |
4043 (vector (event-apply-modifier (read-event) 'alt 22 "A-"))) | 5040 (vector (event-apply-modifier (read-event) 'alt 22 "A-"))) |
4044 (defun event-apply-super-modifier (ignore-prompt) | 5041 (defun event-apply-super-modifier (ignore-prompt) |
4045 "Add the Super modifier to the following event. | 5042 "\\<function-key-map>Add the Super modifier to the following event. |
4046 For example, type \\[event-apply-super-modifier] & to enter Super-&." | 5043 For example, type \\[event-apply-super-modifier] & to enter Super-&." |
4047 (vector (event-apply-modifier (read-event) 'super 23 "s-"))) | 5044 (vector (event-apply-modifier (read-event) 'super 23 "s-"))) |
4048 (defun event-apply-hyper-modifier (ignore-prompt) | 5045 (defun event-apply-hyper-modifier (ignore-prompt) |
4049 "Add the Hyper modifier to the following event. | 5046 "\\<function-key-map>Add the Hyper modifier to the following event. |
4050 For example, type \\[event-apply-hyper-modifier] & to enter Hyper-&." | 5047 For example, type \\[event-apply-hyper-modifier] & to enter Hyper-&." |
4051 (vector (event-apply-modifier (read-event) 'hyper 24 "H-"))) | 5048 (vector (event-apply-modifier (read-event) 'hyper 24 "H-"))) |
4052 (defun event-apply-shift-modifier (ignore-prompt) | 5049 (defun event-apply-shift-modifier (ignore-prompt) |
4053 "Add the Shift modifier to the following event. | 5050 "\\<function-key-map>Add the Shift modifier to the following event. |
4054 For example, type \\[event-apply-shift-modifier] & to enter Shift-&." | 5051 For example, type \\[event-apply-shift-modifier] & to enter Shift-&." |
4055 (vector (event-apply-modifier (read-event) 'shift 25 "S-"))) | 5052 (vector (event-apply-modifier (read-event) 'shift 25 "S-"))) |
4056 (defun event-apply-control-modifier (ignore-prompt) | 5053 (defun event-apply-control-modifier (ignore-prompt) |
4057 "Add the Ctrl modifier to the following event. | 5054 "\\<function-key-map>Add the Ctrl modifier to the following event. |
4058 For example, type \\[event-apply-control-modifier] & to enter Ctrl-&." | 5055 For example, type \\[event-apply-control-modifier] & to enter Ctrl-&." |
4059 (vector (event-apply-modifier (read-event) 'control 26 "C-"))) | 5056 (vector (event-apply-modifier (read-event) 'control 26 "C-"))) |
4060 (defun event-apply-meta-modifier (ignore-prompt) | 5057 (defun event-apply-meta-modifier (ignore-prompt) |
4061 "Add the Meta modifier to the following event. | 5058 "\\<function-key-map>Add the Meta modifier to the following event. |
4062 For example, type \\[event-apply-meta-modifier] & to enter Meta-&." | 5059 For example, type \\[event-apply-meta-modifier] & to enter Meta-&." |
4063 (vector (event-apply-modifier (read-event) 'meta 27 "M-"))) | 5060 (vector (event-apply-modifier (read-event) 'meta 27 "M-"))) |
4064 | 5061 |
4065 (defun event-apply-modifier (event symbol lshiftby prefix) | 5062 (defun event-apply-modifier (event symbol lshiftby prefix) |
4066 "Apply a modifier flag to event EVENT. | 5063 "Apply a modifier flag to event EVENT. |
4112 (normal (nth 1 keypad-normal))) | 5109 (normal (nth 1 keypad-normal))) |
4113 (put keypad 'ascii-character normal) | 5110 (put keypad 'ascii-character normal) |
4114 (define-key function-key-map (vector keypad) (vector normal)))) | 5111 (define-key function-key-map (vector keypad) (vector normal)))) |
4115 '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4) | 5112 '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4) |
4116 (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9) | 5113 (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9) |
4117 (kp-space ?\ ) | 5114 (kp-space ?\s) |
4118 (kp-tab ?\t) | 5115 (kp-tab ?\t) |
4119 (kp-enter ?\r) | 5116 (kp-enter ?\r) |
4120 (kp-multiply ?*) | 5117 (kp-multiply ?*) |
4121 (kp-add ?+) | 5118 (kp-add ?+) |
4122 (kp-separator ?,) | 5119 (kp-separator ?,) |
4166 | 5163 |
4167 ;; things to maybe add (currently partly covered by `funcall mode'): | 5164 ;; things to maybe add (currently partly covered by `funcall mode'): |
4168 ;; - syntax-table | 5165 ;; - syntax-table |
4169 ;; - overlays | 5166 ;; - overlays |
4170 (defun clone-buffer (&optional newname display-flag) | 5167 (defun clone-buffer (&optional newname display-flag) |
4171 "Create a twin copy of the current buffer. | 5168 "Create and return a twin copy of the current buffer. |
4172 If NEWNAME is nil, it defaults to the current buffer's name; | 5169 Unlike an indirect buffer, the new buffer can be edited |
4173 NEWNAME is modified by adding or incrementing <N> at the end as necessary. | 5170 independently of the old one (if it is not read-only). |
4174 | 5171 NEWNAME is the name of the new buffer. It may be modified by |
4175 If DISPLAY-FLAG is non-nil, the new buffer is shown with `pop-to-buffer'. | 5172 adding or incrementing <N> at the end as necessary to create a |
5173 unique buffer name. If nil, it defaults to the name of the | |
5174 current buffer, with the proper suffix. If DISPLAY-FLAG is | |
5175 non-nil, the new buffer is shown with `pop-to-buffer'. Trying to | |
5176 clone a file-visiting buffer, or a buffer whose major mode symbol | |
5177 has a non-nil `no-clone' property, results in an error. | |
5178 | |
5179 Interactively, DISPLAY-FLAG is t and NEWNAME is the name of the | |
5180 current buffer with appropriate suffix. However, if a prefix | |
5181 argument is given, then the command prompts for NEWNAME in the | |
5182 minibuffer. | |
5183 | |
4176 This runs the normal hook `clone-buffer-hook' in the new buffer | 5184 This runs the normal hook `clone-buffer-hook' in the new buffer |
4177 after it has been set up properly in other respects." | 5185 after it has been set up properly in other respects." |
4178 (interactive | 5186 (interactive |
4179 (progn | 5187 (progn |
4180 (if buffer-file-name | 5188 (if buffer-file-name |
4233 | 5241 |
4234 | 5242 |
4235 (defun clone-indirect-buffer (newname display-flag &optional norecord) | 5243 (defun clone-indirect-buffer (newname display-flag &optional norecord) |
4236 "Create an indirect buffer that is a twin copy of the current buffer. | 5244 "Create an indirect buffer that is a twin copy of the current buffer. |
4237 | 5245 |
4238 Give the indirect buffer name NEWNAME. Interactively, read NEW-NAME | 5246 Give the indirect buffer name NEWNAME. Interactively, read NEWNAME |
4239 from the minibuffer when invoked with a prefix arg. If NEWNAME is nil | 5247 from the minibuffer when invoked with a prefix arg. If NEWNAME is nil |
4240 or if not called with a prefix arg, NEWNAME defaults to the current | 5248 or if not called with a prefix arg, NEWNAME defaults to the current |
4241 buffer's name. The name is modified by adding a `<N>' suffix to it | 5249 buffer's name. The name is modified by adding a `<N>' suffix to it |
4242 or by incrementing the N in an existing suffix. | 5250 or by incrementing the N in an existing suffix. |
4243 | 5251 |
4244 DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'. | 5252 DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'. |
4245 This is always done when called interactively. | 5253 This is always done when called interactively. |
4246 | 5254 |
4247 Optional last arg NORECORD non-nil means do not put this buffer at the | 5255 Optional third arg NORECORD non-nil means do not put this buffer at the |
4248 front of the list of recently selected ones." | 5256 front of the list of recently selected ones." |
4249 (interactive | 5257 (interactive |
4250 (progn | 5258 (progn |
4251 (if (get major-mode 'no-clone-indirect) | 5259 (if (get major-mode 'no-clone-indirect) |
4252 (error "Cannot indirectly clone a buffer in %s mode" mode-name)) | 5260 (error "Cannot indirectly clone a buffer in %s mode" mode-name)) |
4273 (interactive "bClone buffer in other window: ") | 5281 (interactive "bClone buffer in other window: ") |
4274 (let ((pop-up-windows t)) | 5282 (let ((pop-up-windows t)) |
4275 (set-buffer buffer) | 5283 (set-buffer buffer) |
4276 (clone-indirect-buffer nil t norecord))) | 5284 (clone-indirect-buffer nil t norecord))) |
4277 | 5285 |
4278 (define-key ctl-x-4-map "c" 'clone-indirect-buffer-other-window) | |
4279 | 5286 |
4280 ;;; Handling of Backspace and Delete keys. | 5287 ;;; Handling of Backspace and Delete keys. |
4281 | 5288 |
4282 (defcustom normal-erase-is-backspace nil | 5289 (defcustom normal-erase-is-backspace |
5290 (and (not noninteractive) | |
5291 (or (memq system-type '(ms-dos windows-nt)) | |
5292 (eq window-system 'mac) | |
5293 (and (memq window-system '(x)) | |
5294 (fboundp 'x-backspace-delete-keys-p) | |
5295 (x-backspace-delete-keys-p)) | |
5296 ;; If the terminal Emacs is running on has erase char | |
5297 ;; set to ^H, use the Backspace key for deleting | |
5298 ;; backward and, and the Delete key for deleting forward. | |
5299 (and (null window-system) | |
5300 (eq tty-erase-char ?\^H)))) | |
4283 "If non-nil, Delete key deletes forward and Backspace key deletes backward. | 5301 "If non-nil, Delete key deletes forward and Backspace key deletes backward. |
4284 | 5302 |
4285 On window systems, the default value of this option is chosen | 5303 On window systems, the default value of this option is chosen |
4286 according to the keyboard used. If the keyboard has both a Backspace | 5304 according to the keyboard used. If the keyboard has both a Backspace |
4287 key and a Delete key, and both are mapped to their usual meanings, the | 5305 key and a Delete key, and both are mapped to their usual meanings, the |
4385 | 5403 |
4386 (run-hooks 'normal-erase-is-backspace-hook) | 5404 (run-hooks 'normal-erase-is-backspace-hook) |
4387 (if (interactive-p) | 5405 (if (interactive-p) |
4388 (message "Delete key deletes %s" | 5406 (message "Delete key deletes %s" |
4389 (if normal-erase-is-backspace "forward" "backward")))) | 5407 (if normal-erase-is-backspace "forward" "backward")))) |
4390 | 5408 |
4391 | 5409 (defvar vis-mode-saved-buffer-invisibility-spec nil |
5410 "Saved value of `buffer-invisibility-spec' when Visible mode is on.") | |
5411 | |
5412 (define-minor-mode visible-mode | |
5413 "Toggle Visible mode. | |
5414 With argument ARG turn Visible mode on iff ARG is positive. | |
5415 | |
5416 Enabling Visible mode makes all invisible text temporarily visible. | |
5417 Disabling Visible mode turns off that effect. Visible mode | |
5418 works by saving the value of `buffer-invisibility-spec' and setting it to nil." | |
5419 :lighter " Vis" | |
5420 :group 'editing-basics | |
5421 (when (local-variable-p 'vis-mode-saved-buffer-invisibility-spec) | |
5422 (setq buffer-invisibility-spec vis-mode-saved-buffer-invisibility-spec) | |
5423 (kill-local-variable 'vis-mode-saved-buffer-invisibility-spec)) | |
5424 (when visible-mode | |
5425 (set (make-local-variable 'vis-mode-saved-buffer-invisibility-spec) | |
5426 buffer-invisibility-spec) | |
5427 (setq buffer-invisibility-spec nil))) | |
5428 | |
4392 ;; Minibuffer prompt stuff. | 5429 ;; Minibuffer prompt stuff. |
4393 | 5430 |
4394 ;(defun minibuffer-prompt-modification (start end) | 5431 ;(defun minibuffer-prompt-modification (start end) |
4395 ; (error "You cannot modify the prompt")) | 5432 ; (error "You cannot modify the prompt")) |
4396 ; | 5433 ; |
4409 ; (list 'modification-hooks '(minibuffer-prompt-modification) | 5446 ; (list 'modification-hooks '(minibuffer-prompt-modification) |
4410 ; 'insert-in-front-hooks '(minibuffer-prompt-insertion))) | 5447 ; 'insert-in-front-hooks '(minibuffer-prompt-insertion))) |
4411 ; | 5448 ; |
4412 | 5449 |
4413 (provide 'simple) | 5450 (provide 'simple) |
5451 | |
5452 ;; arch-tag: 24af67c0-2a49-44f6-b3b1-312d8b570dfd | |
4414 ;;; simple.el ends here | 5453 ;;; simple.el ends here |