grep-command and grep-find-command user options.
[bpt/emacs.git] / lisp / simple.el
CommitLineData
c88ab9ce
ER
1;;; simple.el --- basic editing commands for Emacs
2
ec9f4754 3;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000, 2001
69c1dd37 4;; Free Software Foundation, Inc.
2076c87c
JB
5
6;; This file is part of GNU Emacs.
7
8;; GNU Emacs is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
3a801d0c 10;; the Free Software Foundation; either version 2, or (at your option)
2076c87c
JB
11;; any later version.
12
13;; GNU Emacs is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
b578f267
EN
19;; along with GNU Emacs; see the file COPYING. If not, write to the
20;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21;; Boston, MA 02111-1307, USA.
2076c87c 22
d9ecc911
ER
23;;; Commentary:
24
25;; A grab-bag of basic Emacs commands not specifically related to some
26;; major mode or to file-handling.
27
3a801d0c 28;;; Code:
2076c87c 29
d01a33cf 30(eval-when-compile
a339f909 31 (autoload 'widget-convert "wid-edit")
9023837e 32 (autoload 'shell-mode "shell")
d01a33cf
GM
33 (require 'cl))
34
35
69c1dd37
RS
36(defgroup killing nil
37 "Killing and yanking commands"
38 :group 'editing)
39
69c1dd37
RS
40(defgroup paren-matching nil
41 "Highlight (un)matching of parens and expressions."
69c1dd37
RS
42 :group 'matching)
43
44
93be67de
KH
45(defun fundamental-mode ()
46 "Major mode not specialized for anything in particular.
47Other major modes are defined by comparison with this one."
48 (interactive)
49 (kill-all-local-variables))
eaae8106 50
93be67de
KH
51;; Making and deleting lines.
52
30bb9754 53(defun newline (&optional arg)
d133d835 54 "Insert a newline, and move to left margin of the new line if it's blank.
30bb9754 55The newline is marked with the text-property `hard'.
76c64e24 56With ARG, insert that many newlines.
30bb9754
BG
57In Auto Fill mode, if no numeric arg, break the preceding line if it's long."
58 (interactive "*P")
4c4cbf11 59 (barf-if-buffer-read-only)
30bb9754
BG
60 ;; Inserting a newline at the end of a line produces better redisplay in
61 ;; try_window_id than inserting at the beginning of a line, and the textual
62 ;; result is the same. So, if we're at beginning of line, pretend to be at
63 ;; the end of the previous line.
1e722f9f 64 (let ((flag (and (not (bobp))
30bb9754 65 (bolp)
1cd24721
RS
66 ;; Make sure no functions want to be told about
67 ;; the range of the changes.
1cd24721
RS
68 (not after-change-functions)
69 (not before-change-functions)
fd977703
RS
70 ;; Make sure there are no markers here.
71 (not (buffer-has-markers-at (1- (point))))
2f047f6c 72 (not (buffer-has-markers-at (point)))
1cd24721
RS
73 ;; Make sure no text properties want to know
74 ;; where the change was.
75 (not (get-char-property (1- (point)) 'modification-hooks))
76 (not (get-char-property (1- (point)) 'insert-behind-hooks))
77 (or (eobp)
78 (not (get-char-property (point) 'insert-in-front-hooks)))
31a5333f
MB
79 ;; Make sure the newline before point isn't intangible.
80 (not (get-char-property (1- (point)) 'intangible))
81 ;; Make sure the newline before point isn't read-only.
82 (not (get-char-property (1- (point)) 'read-only))
83 ;; Make sure the newline before point isn't invisible.
84 (not (get-char-property (1- (point)) 'invisible))
85 ;; Make sure the newline before point has the same
86 ;; properties as the char before it (if any).
1e722f9f 87 (< (or (previous-property-change (point)) -2)
d133d835
RS
88 (- (point) 2))))
89 (was-page-start (and (bolp)
90 (looking-at page-delimiter)))
91 (beforepos (point)))
30bb9754
BG
92 (if flag (backward-char 1))
93 ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
94 ;; Set last-command-char to tell self-insert what to insert.
95 (let ((last-command-char ?\n)
96 ;; Don't auto-fill if we have a numeric argument.
3954fff9
RS
97 ;; Also not if flag is true (it would fill wrong line);
98 ;; there is no need to since we're at BOL.
99 (auto-fill-function (if (or arg flag) nil auto-fill-function)))
4cc9d0dc
RS
100 (unwind-protect
101 (self-insert-command (prefix-numeric-value arg))
102 ;; If we get an error in self-insert-command, put point at right place.
103 (if flag (forward-char 1))))
2f047f6c
KH
104 ;; Even if we did *not* get an error, keep that forward-char;
105 ;; all further processing should apply to the newline that the user
106 ;; thinks he inserted.
107
30bb9754
BG
108 ;; Mark the newline(s) `hard'.
109 (if use-hard-newlines
2f047f6c 110 (set-hard-newline-properties
55741b46 111 (- (point) (if arg (prefix-numeric-value arg) 1)) (point)))
d133d835
RS
112 ;; If the newline leaves the previous line blank,
113 ;; and we have a left margin, delete that from the blank line.
114 (or flag
115 (save-excursion
116 (goto-char beforepos)
117 (beginning-of-line)
118 (and (looking-at "[ \t]$")
119 (> (current-left-margin) 0)
120 (delete-region (point) (progn (end-of-line) (point))))))
d133d835
RS
121 ;; Indent the line after the newline, except in one case:
122 ;; when we added the newline at the beginning of a line
123 ;; which starts a page.
124 (or was-page-start
125 (move-to-left-margin nil t)))
30bb9754
BG
126 nil)
127
55741b46
RS
128(defun set-hard-newline-properties (from to)
129 (let ((sticky (get-text-property from 'rear-nonsticky)))
130 (put-text-property from to 'hard 't)
131 ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
132 (if (and (listp sticky) (not (memq 'hard sticky)))
133 (put-text-property from (point) 'rear-nonsticky
134 (cons 'hard sticky)))))
eaae8106 135
2076c87c 136(defun open-line (arg)
ff1fbe3e 137 "Insert a newline and leave point before it.
3db1e3b5 138If there is a fill prefix and/or a left-margin, insert them on the new line
d133d835 139if the line would have been blank.
616ed245 140With arg N, insert N newlines."
2076c87c 141 (interactive "*p")
616ed245 142 (let* ((do-fill-prefix (and fill-prefix (bolp)))
3db1e3b5 143 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
207d7545
GM
144 (loc (point))
145 ;; Don't expand an abbrev before point.
146 (abbrev-mode nil))
d133d835
RS
147 (newline arg)
148 (goto-char loc)
28191e20 149 (while (> arg 0)
d133d835
RS
150 (cond ((bolp)
151 (if do-left-margin (indent-to (current-left-margin)))
152 (if do-fill-prefix (insert-and-inherit fill-prefix))))
153 (forward-line 1)
28191e20 154 (setq arg (1- arg)))
d133d835
RS
155 (goto-char loc)
156 (end-of-line)))
2076c87c
JB
157
158(defun split-line ()
159 "Split current line, moving portion beyond point vertically down."
160 (interactive "*")
161 (skip-chars-forward " \t")
162 (let ((col (current-column))
163 (pos (point)))
28191e20 164 (newline 1)
2076c87c
JB
165 (indent-to col 0)
166 (goto-char pos)))
167
2076c87c
JB
168(defun delete-indentation (&optional arg)
169 "Join this line to previous and fix up whitespace at join.
ccc58657 170If there is a fill prefix, delete it from the beginning of this line.
2076c87c
JB
171With argument, join this line to following line."
172 (interactive "*P")
173 (beginning-of-line)
174 (if arg (forward-line 1))
175 (if (eq (preceding-char) ?\n)
176 (progn
177 (delete-region (point) (1- (point)))
ccc58657
RS
178 ;; If the second line started with the fill prefix,
179 ;; delete the prefix.
180 (if (and fill-prefix
01b8e020 181 (<= (+ (point) (length fill-prefix)) (point-max))
ccc58657
RS
182 (string= fill-prefix
183 (buffer-substring (point)
184 (+ (point) (length fill-prefix)))))
185 (delete-region (point) (+ (point) (length fill-prefix))))
2076c87c
JB
186 (fixup-whitespace))))
187
fc025090 188(defalias 'join-line #'delete-indentation) ; easier to find
eaae8106 189
2076c87c
JB
190(defun delete-blank-lines ()
191 "On blank line, delete all surrounding blank lines, leaving just one.
192On isolated blank line, delete that one.
6d30d416 193On nonblank line, delete any immediately following blank lines."
2076c87c
JB
194 (interactive "*")
195 (let (thisblank singleblank)
196 (save-excursion
197 (beginning-of-line)
198 (setq thisblank (looking-at "[ \t]*$"))
70e14c01 199 ;; Set singleblank if there is just one blank line here.
2076c87c
JB
200 (setq singleblank
201 (and thisblank
202 (not (looking-at "[ \t]*\n[ \t]*$"))
203 (or (bobp)
204 (progn (forward-line -1)
205 (not (looking-at "[ \t]*$")))))))
70e14c01 206 ;; Delete preceding blank lines, and this one too if it's the only one.
2076c87c
JB
207 (if thisblank
208 (progn
209 (beginning-of-line)
210 (if singleblank (forward-line 1))
211 (delete-region (point)
212 (if (re-search-backward "[^ \t\n]" nil t)
213 (progn (forward-line 1) (point))
214 (point-min)))))
70e14c01
JB
215 ;; Delete following blank lines, unless the current line is blank
216 ;; and there are no following blank lines.
2076c87c
JB
217 (if (not (and thisblank singleblank))
218 (save-excursion
219 (end-of-line)
220 (forward-line 1)
221 (delete-region (point)
222 (if (re-search-forward "[^ \t\n]" nil t)
223 (progn (beginning-of-line) (point))
70e14c01
JB
224 (point-max)))))
225 ;; Handle the special case where point is followed by newline and eob.
226 ;; Delete the line, leaving point at eob.
227 (if (looking-at "^[ \t]*\n\\'")
228 (delete-region (point) (point-max)))))
2076c87c 229
eaae8106
SS
230(defun delete-trailing-whitespace ()
231 "Delete all the trailing whitespace across the current buffer.
232All whitespace after the last non-whitespace character in a line is deleted.
103db06c
RS
233This respects narrowing, created by \\[narrow-to-region] and friends.
234A formfeed is not considered whitespace by this function."
eaae8106
SS
235 (interactive "*")
236 (save-match-data
237 (save-excursion
238 (goto-char (point-min))
5c9b3fac
MB
239 (while (re-search-forward "\\s-$" nil t)
240 (skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
3a768251 241 ;; Don't delete formfeeds, even if they are considered whitespace.
661aa5c7
GM
242 (save-match-data
243 (if (looking-at ".*\f")
244 (goto-char (match-end 0))))
7981d89f 245 (delete-region (point) (match-end 0))))))
eaae8106 246
2076c87c
JB
247(defun newline-and-indent ()
248 "Insert a newline, then indent according to major mode.
ff1fbe3e 249Indentation is done using the value of `indent-line-function'.
2076c87c 250In programming language modes, this is the same as TAB.
ff1fbe3e 251In some text modes, where TAB inserts a tab, this command indents to the
eed5698b 252column specified by the function `current-left-margin'."
2076c87c 253 (interactive "*")
5ff4ba3d 254 (delete-horizontal-space t)
46947372 255 (newline)
2076c87c
JB
256 (indent-according-to-mode))
257
258(defun reindent-then-newline-and-indent ()
259 "Reindent current line, insert newline, then indent the new line.
260Indentation of both lines is done according to the current major mode,
ff1fbe3e 261which means calling the current value of `indent-line-function'.
2076c87c
JB
262In programming language modes, this is the same as TAB.
263In some text modes, where TAB inserts a tab, this indents to the
eed5698b 264column specified by the function `current-left-margin'."
2076c87c
JB
265 (interactive "*")
266 (save-excursion
5ff4ba3d 267 (delete-horizontal-space t)
2076c87c 268 (indent-according-to-mode))
46947372 269 (newline)
2076c87c 270 (indent-according-to-mode))
eaae8106 271
93be67de
KH
272(defun quoted-insert (arg)
273 "Read next input character and insert it.
274This is useful for inserting control characters.
2076c87c 275
93be67de
KH
276If the first character you type after this command is an octal digit,
277you should type a sequence of octal digits which specify a character code.
278Any nondigit terminates the sequence. If the terminator is a RET,
279it is discarded; any other terminator is used itself as input.
280The variable `read-quoted-char-radix' specifies the radix for this feature;
281set it to 10 or 16 to use decimal or hex instead of octal.
dff7d67f 282
93be67de
KH
283In overwrite mode, this function inserts the character anyway, and
284does not handle octal digits specially. This means that if you use
285overwrite as your normal editing mode, you can use this function to
286insert characters when necessary.
dff7d67f 287
93be67de
KH
288In binary overwrite mode, this function does overwrite, and octal
289digits are interpreted as a character code. This is intended to be
290useful for editing binary files."
291 (interactive "*p")
292 (let ((char (if (or (not overwrite-mode)
293 (eq overwrite-mode 'overwrite-mode-binary))
294 (read-quoted-char)
295 (read-char))))
296 ;; Assume character codes 0240 - 0377 stand for characters in some
297 ;; single-byte character set, and convert them to Emacs
298 ;; characters.
299 (if (and enable-multibyte-characters
300 (>= char ?\240)
301 (<= char ?\377))
302 (setq char (unibyte-char-to-multibyte char)))
303 (if (> arg 0)
304 (if (eq overwrite-mode 'overwrite-mode-binary)
305 (delete-char arg)))
306 (while (> arg 0)
307 (insert-and-inherit char)
308 (setq arg (1- arg)))))
eaae8106 309
93be67de
KH
310(defun forward-to-indentation (arg)
311 "Move forward ARG lines and position at first nonblank character."
312 (interactive "p")
313 (forward-line arg)
314 (skip-chars-forward " \t"))
cc2b2b6c 315
93be67de
KH
316(defun backward-to-indentation (arg)
317 "Move backward ARG lines and position at first nonblank character."
318 (interactive "p")
319 (forward-line (- arg))
320 (skip-chars-forward " \t"))
2076c87c 321
93be67de
KH
322(defun back-to-indentation ()
323 "Move point to the first non-whitespace character on this line."
324 (interactive)
325 (beginning-of-line 1)
326 (skip-chars-forward " \t"))
327
328(defun fixup-whitespace ()
329 "Fixup white space between objects around point.
330Leave one space or none, according to the context."
331 (interactive "*")
332 (save-excursion
333 (delete-horizontal-space)
334 (if (or (looking-at "^\\|\\s)")
335 (save-excursion (forward-char -1)
336 (looking-at "$\\|\\s(\\|\\s'")))
337 nil
338 (insert ?\ ))))
339
5ff4ba3d
MB
340(defun delete-horizontal-space (&optional backward-only)
341 "Delete all spaces and tabs around point.
342If BACKWARD-ONLY is non-nil, only delete spaces before point."
93be67de 343 (interactive "*")
9ab59a1a
MB
344 (let ((orig-pos (point)))
345 (delete-region
346 (if backward-only
347 orig-pos
348 (progn
349 (skip-chars-forward " \t")
350 (constrain-to-field nil orig-pos t)))
5ff4ba3d 351 (progn
9ab59a1a
MB
352 (skip-chars-backward " \t")
353 (constrain-to-field nil orig-pos)))))
93be67de
KH
354
355(defun just-one-space ()
356 "Delete all spaces and tabs around point, leaving one space."
357 (interactive "*")
9ab59a1a
MB
358 (let ((orig-pos (point)))
359 (skip-chars-backward " \t")
360 (constrain-to-field nil orig-pos)
361 (if (= (following-char) ? )
362 (forward-char 1)
363 (insert ? ))
364 (delete-region
365 (point)
366 (progn
367 (skip-chars-forward " \t")
368 (constrain-to-field nil orig-pos t)))))
eaae8106 369
2076c87c
JB
370(defun beginning-of-buffer (&optional arg)
371 "Move point to the beginning of the buffer; leave mark at previous position.
c66587fe
RS
372With arg N, put point N/10 of the way from the beginning.
373
374If the buffer is narrowed, this command uses the beginning and size
375of the accessible part of the buffer.
ff1fbe3e
RS
376
377Don't use this command in Lisp programs!
2076c87c
JB
378\(goto-char (point-min)) is faster and avoids clobbering the mark."
379 (interactive "P")
380 (push-mark)
c66587fe
RS
381 (let ((size (- (point-max) (point-min))))
382 (goto-char (if arg
383 (+ (point-min)
384 (if (> size 10000)
385 ;; Avoid overflow for large buffer sizes!
386 (* (prefix-numeric-value arg)
387 (/ size 10))
388 (/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
389 (point-min))))
2076c87c
JB
390 (if arg (forward-line 1)))
391
392(defun end-of-buffer (&optional arg)
393 "Move point to the end of the buffer; leave mark at previous position.
c66587fe
RS
394With arg N, put point N/10 of the way from the end.
395
396If the buffer is narrowed, this command uses the beginning and size
397of the accessible part of the buffer.
ff1fbe3e
RS
398
399Don't use this command in Lisp programs!
2076c87c
JB
400\(goto-char (point-max)) is faster and avoids clobbering the mark."
401 (interactive "P")
402 (push-mark)
c66587fe
RS
403 (let ((size (- (point-max) (point-min))))
404 (goto-char (if arg
405 (- (point-max)
406 (if (> size 10000)
407 ;; Avoid overflow for large buffer sizes!
408 (* (prefix-numeric-value arg)
409 (/ size 10))
410 (/ (* size (prefix-numeric-value arg)) 10)))
411 (point-max))))
3a801d0c
ER
412 ;; If we went to a place in the middle of the buffer,
413 ;; adjust it to the beginning of a line.
314808dc
GM
414 (cond (arg (forward-line 1))
415 ((< (point) (window-end nil t))
416 ;; If the end of the buffer is not already on the screen,
417 ;; then scroll specially to put it near, but not at, the bottom.
418 (overlay-recenter (point))
419 (recenter -3))))
2076c87c
JB
420
421(defun mark-whole-buffer ()
70e14c01
JB
422 "Put point at beginning and mark at end of buffer.
423You probably should not use this function in Lisp programs;
424it is usually a mistake for a Lisp function to use any subroutine
425that uses or sets the mark."
2076c87c
JB
426 (interactive)
427 (push-mark (point))
fd0f4056 428 (push-mark (point-max) nil t)
2076c87c 429 (goto-char (point-min)))
fa65f20b 430
eaae8106 431
93be67de
KH
432;; Counting lines, one way or another.
433
434(defun goto-line (arg)
435 "Goto line ARG, counting from line 1 at beginning of buffer."
436 (interactive "NGoto line: ")
437 (setq arg (prefix-numeric-value arg))
438 (save-restriction
439 (widen)
440 (goto-char 1)
441 (if (eq selective-display t)
442 (re-search-forward "[\n\C-m]" nil 'end (1- arg))
443 (forward-line (1- arg)))))
2076c87c
JB
444
445(defun count-lines-region (start end)
eb8c3be9 446 "Print number of lines and characters in the region."
2076c87c
JB
447 (interactive "r")
448 (message "Region has %d lines, %d characters"
449 (count-lines start end) (- end start)))
450
451(defun what-line ()
2578be76 452 "Print the current buffer line number and narrowed line number of point."
2076c87c 453 (interactive)
2578be76 454 (let ((opoint (point)) start)
2076c87c 455 (save-excursion
2578be76
RS
456 (save-restriction
457 (goto-char (point-min))
458 (widen)
459 (beginning-of-line)
460 (setq start (point))
461 (goto-char opoint)
462 (beginning-of-line)
463 (if (/= start 1)
464 (message "line %d (narrowed line %d)"
465 (1+ (count-lines 1 (point)))
466 (1+ (count-lines start (point))))
467 (message "Line %d" (1+ (count-lines 1 (point)))))))))
468
2076c87c
JB
469(defun count-lines (start end)
470 "Return number of lines between START and END.
471This is usually the number of newlines between them,
ff1fbe3e 472but can be one more if START is not equal to END
2076c87c 473and the greater of them is not at the start of a line."
e406700d
RS
474 (save-excursion
475 (save-restriction
476 (narrow-to-region start end)
477 (goto-char (point-min))
478 (if (eq selective-display t)
479 (save-match-data
dde92ca6
RS
480 (let ((done 0))
481 (while (re-search-forward "[\n\C-m]" nil t 40)
482 (setq done (+ 40 done)))
483 (while (re-search-forward "[\n\C-m]" nil t 1)
484 (setq done (+ 1 done)))
043efc41
RS
485 (goto-char (point-max))
486 (if (and (/= start end)
487 (not (bolp)))
488 (1+ done)
e406700d
RS
489 done)))
490 (- (buffer-size) (forward-line (buffer-size)))))))
eaae8106 491
d5d99b80
KH
492(defun what-cursor-position (&optional detail)
493 "Print info on cursor position (on screen and within buffer).
e38dff0c 494Also describe the character after point, and give its character code
c6fcc518
KH
495in octal, decimal and hex.
496
497For a non-ASCII multibyte character, also give its encoding in the
498buffer's selected coding system if the coding system encodes the
499character safely. If the character is encoded into one byte, that
500code is shown in hex. If the character is encoded into more than one
501byte, just \"...\" is shown.
e5a902cf 502
24dad5d5
KH
503In addition, with prefix argument, show details about that character
504in *Help* buffer. See also the command `describe-char-after'."
d5d99b80 505 (interactive "P")
2076c87c
JB
506 (let* ((char (following-char))
507 (beg (point-min))
508 (end (point-max))
509 (pos (point))
510 (total (buffer-size))
511 (percent (if (> total 50000)
512 ;; Avoid overflow from multiplying by 100!
513 (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
514 (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
515 (hscroll (if (= (window-hscroll) 0)
516 ""
517 (format " Hscroll=%d" (window-hscroll))))
518 (col (current-column)))
519 (if (= pos end)
520 (if (or (/= beg 1) (/= end (1+ total)))
74fd2380 521 (message "point=%d of %d (%d%%) <%d - %d> column %d %s"
2076c87c 522 pos total percent beg end col hscroll)
74fd2380 523 (message "point=%d of %d (%d%%) column %d %s"
2076c87c 524 pos total percent col hscroll))
c6fcc518
KH
525 (let ((coding buffer-file-coding-system)
526 encoded encoding-msg)
527 (if (or (not coding)
528 (eq (coding-system-type coding) t))
529 (setq coding default-buffer-file-coding-system))
28fd4883
KH
530 (if (not (char-valid-p char))
531 (setq encoding-msg
532 (format "(0%o, %d, 0x%x, invalid)" char char char))
533 (setq encoded (and (>= char 128) (encode-coding-char char coding)))
534 (setq encoding-msg
535 (if encoded
24dad5d5 536 (format "(0%o, %d, 0x%x, file %s)"
28fd4883 537 char char char
24dad5d5 538 (if (> (length encoded) 1)
28fd4883 539 "..."
24dad5d5 540 (encoded-string-description encoded coding)))
28fd4883 541 (format "(0%o, %d, 0x%x)" char char char))))
e5e89e48 542 (if detail
24dad5d5
KH
543 ;; We show the detailed information about CHAR.
544 (describe-char-after (point)))
545 (if (or (/= beg 1) (/= end (1+ total)))
546 (message "Char: %s %s point=%d of %d (%d%%) <%d - %d> column %d %s"
e5a902cf
KH
547 (if (< char 256)
548 (single-key-description char)
f0d16a7f 549 (buffer-substring-no-properties (point) (1+ (point))))
24dad5d5
KH
550 encoding-msg pos total percent beg end col hscroll)
551 (message "Char: %s %s point=%d of %d (%d%%) column %d %s"
552 (if (< char 256)
553 (single-key-description char)
554 (buffer-substring-no-properties (point) (1+ (point))))
555 encoding-msg pos total percent col hscroll))))))
eaae8106 556
76c64e24
SM
557(defvar read-expression-map
558 (let ((m (make-sparse-keymap)))
559 (define-key m "\M-\t" 'lisp-complete-symbol)
560 (set-keymap-parent m minibuffer-local-map)
561 m)
854c16c5 562 "Minibuffer keymap used for reading Lisp expressions.")
854c16c5 563
8570b0ca
RM
564(defvar read-expression-history nil)
565
b49df39d
RS
566(defcustom eval-expression-print-level 4
567 "*Value to use for `print-level' when printing value in `eval-expression'."
568 :group 'lisp
e8b1643c 569 :type '(choice (const nil) integer)
b49df39d
RS
570 :version "21.1")
571
572(defcustom eval-expression-print-length 12
573 "*Value to use for `print-length' when printing value in `eval-expression'."
574 :group 'lisp
56437999 575 :type '(choice (const nil) integer)
b49df39d
RS
576 :version "21.1")
577
578(defcustom eval-expression-debug-on-error t
ed8bcabe
GM
579 "*Non-nil means set `debug-on-error' when evaluating in `eval-expression'.
580If nil, don't change the value of `debug-on-error'."
b49df39d
RS
581 :group 'lisp
582 :type 'boolean
583 :version "21.1")
584
8570b0ca 585;; We define this, rather than making `eval' interactive,
2076c87c 586;; for the sake of completion of names like eval-region, eval-current-buffer.
ecb7ad00
RS
587(defun eval-expression (eval-expression-arg
588 &optional eval-expression-insert-value)
a6a1ee53
EZ
589 "Evaluate EVAL-EXPRESSION-ARG and print value in the echo area.
590Value is also consed on to front of the variable `values'.
591Optional argument EVAL-EXPRESSION-INSERT-VALUE, if non-nil, means
592insert the result into the current buffer instead of printing it in
593the echo area."
adca5fa6 594 (interactive
b387ef9a
RS
595 (list (read-from-minibuffer "Eval: "
596 nil read-expression-map t
ecb7ad00
RS
597 'read-expression-history)
598 current-prefix-arg))
eaae8106 599
ed8bcabe
GM
600 (if (null eval-expression-debug-on-error)
601 (setq values (cons (eval eval-expression-arg) values))
602 (let ((old-value (make-symbol "t")) new-value)
603 ;; Bind debug-on-error to something unique so that we can
604 ;; detect when evaled code changes it.
605 (let ((debug-on-error old-value))
606 (setq values (cons (eval eval-expression-arg) values))
607 (setq new-value debug-on-error))
608 ;; If evaled code has changed the value of debug-on-error,
609 ;; propagate that change to the global binding.
610 (unless (eq old-value new-value)
611 (setq debug-on-error new-value))))
eaae8106 612
b49df39d
RS
613 (let ((print-length eval-expression-print-length)
614 (print-level eval-expression-print-level))
615 (prin1 (car values)
616 (if eval-expression-insert-value (current-buffer) t))))
2076c87c
JB
617
618(defun edit-and-eval-command (prompt command)
619 "Prompting with PROMPT, let user edit COMMAND and eval result.
620COMMAND is a Lisp expression. Let user edit that expression in
621the minibuffer, then read and evaluate the result."
b387ef9a
RS
622 (let ((command (read-from-minibuffer prompt
623 (prin1-to-string command)
624 read-expression-map t
625 '(command-history . 1))))
5d6c83ae 626 ;; If command was added to command-history as a string,
1f238ac2 627 ;; get rid of that. We want only evaluable expressions there.
5d6c83ae
KH
628 (if (stringp (car command-history))
629 (setq command-history (cdr command-history)))
630
631 ;; If command to be redone does not match front of history,
632 ;; add it to the history.
633 (or (equal command (car command-history))
634 (setq command-history (cons command command-history)))
2076c87c
JB
635 (eval command)))
636
ebb61177 637(defun repeat-complex-command (arg)
2076c87c
JB
638 "Edit and re-evaluate last complex command, or ARGth from last.
639A complex command is one which used the minibuffer.
640The command is placed in the minibuffer as a Lisp form for editing.
641The result is executed, repeating the command as changed.
642If the command has been changed or is not the most recent previous command
643it is added to the front of the command history.
eb6e9899
RS
644You can use the minibuffer history commands \\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
645to get different commands to edit and resubmit."
2076c87c 646 (interactive "p")
ba343182 647 (let ((elt (nth (1- arg) command-history))
2076c87c
JB
648 newcmd)
649 (if elt
854c16c5 650 (progn
eab22e27 651 (setq newcmd
74ae5fab
RS
652 (let ((print-level nil)
653 (minibuffer-history-position arg)
99ea24de 654 (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
7908d27c
RS
655 (read-from-minibuffer
656 "Redo: " (prin1-to-string elt) read-expression-map t
657 (cons 'command-history arg))))
eab22e27 658
db16f109 659 ;; If command was added to command-history as a string,
1f238ac2 660 ;; get rid of that. We want only evaluable expressions there.
db16f109
RS
661 (if (stringp (car command-history))
662 (setq command-history (cdr command-history)))
663
664 ;; If command to be redone does not match front of history,
665 ;; add it to the history.
666 (or (equal newcmd (car command-history))
667 (setq command-history (cons newcmd command-history)))
2076c87c
JB
668 (eval newcmd))
669 (ding))))
eaae8106 670
854c16c5
RS
671(defvar minibuffer-history nil
672 "Default minibuffer history list.
673This is used for all minibuffer input
674except when an alternate history list is specified.")
675(defvar minibuffer-history-sexp-flag nil
c2d4b6d9 676 "Non-nil when doing history operations on `command-history'.
854c16c5 677More generally, indicates that the history list being acted on
99ea24de
KH
678contains expressions rather than strings.
679It is only valid if its value equals the current minibuffer depth,
680to handle recursive uses of the minibuffer.")
e91f80c4
RS
681(setq minibuffer-history-variable 'minibuffer-history)
682(setq minibuffer-history-position nil)
854c16c5 683(defvar minibuffer-history-search-history nil)
e91f80c4 684
29929437 685(mapcar
d0678801
RM
686 (lambda (key-and-command)
687 (mapcar
688 (lambda (keymap-and-completionp)
689 ;; Arg is (KEYMAP-SYMBOL . COMPLETION-MAP-P).
690 ;; If the cdr of KEY-AND-COMMAND (the command) is a cons,
691 ;; its car is used if COMPLETION-MAP-P is nil, its cdr if it is t.
692 (define-key (symbol-value (car keymap-and-completionp))
693 (car key-and-command)
694 (let ((command (cdr key-and-command)))
695 (if (consp command)
b5e6f936
RM
696 ;; (and ... nil) => ... turns back on the completion-oriented
697 ;; history commands which rms turned off since they seem to
698 ;; do things he doesn't like.
699 (if (and (cdr keymap-and-completionp) nil) ;XXX turned off
d81362b0 700 (progn (error "EMACS BUG!") (cdr command))
d0678801
RM
701 (car command))
702 command))))
703 '((minibuffer-local-map . nil)
704 (minibuffer-local-ns-map . nil)
705 (minibuffer-local-completion-map . t)
706 (minibuffer-local-must-match-map . t)
707 (read-expression-map . nil))))
d81362b0
RM
708 '(("\en" . (next-history-element . next-complete-history-element))
709 ([next] . (next-history-element . next-complete-history-element))
710 ("\ep" . (previous-history-element . previous-complete-history-element))
711 ([prior] . (previous-history-element . previous-complete-history-element))
29929437
JB
712 ("\er" . previous-matching-history-element)
713 ("\es" . next-matching-history-element)))
e91f80c4 714
93cee14b
RS
715(defvar minibuffer-text-before-history nil
716 "Text that was in this minibuffer before any history commands.
717This is nil if there have not yet been any history commands
718in this use of the minibuffer.")
719
720(add-hook 'minibuffer-setup-hook 'minibuffer-history-initialize)
721
722(defun minibuffer-history-initialize ()
723 (setq minibuffer-text-before-history nil))
724
6e7d0ff7
MB
725(defun minibuffer-avoid-prompt (new old)
726 "A point-motion hook for the minibuffer, that moves point out of the prompt."
727 (constrain-to-field nil (point-max)))
728
6e30a99a
RS
729(defcustom minibuffer-history-case-insensitive-variables nil
730 "*Minibuffer history variables for which matching should ignore case.
731If a history variable is a member of this list, then the
732\\[previous-matching-history-element] and \\[next-matching-history-element]\
733 commands ignore case when searching it, regardless of `case-fold-search'."
734 :type '(repeat variable)
735 :group 'minibuffer)
736
e91f80c4 737(defun previous-matching-history-element (regexp n)
854c16c5
RS
738 "Find the previous history element that matches REGEXP.
739\(Previous history elements refer to earlier actions.)
740With prefix argument N, search for Nth previous match.
5c2010f0 741If N is negative, find the next or Nth next match.
9889af08
EZ
742Normally, history elements are matched case-insensitively if
743`case-fold-search' is non-nil, but an uppercase letter in REGEXP
744makes the search case-sensitive.
6e30a99a 745See also `minibuffer-history-case-insensitive-variables'."
854c16c5 746 (interactive
c1172a19 747 (let* ((enable-recursive-minibuffers t)
c1172a19
RS
748 (regexp (read-from-minibuffer "Previous element matching (regexp): "
749 nil
750 minibuffer-local-map
751 nil
752 'minibuffer-history-search-history)))
753 ;; Use the last regexp specified, by default, if input is empty.
754 (list (if (string= regexp "")
a8e96cea
KH
755 (if minibuffer-history-search-history
756 (car minibuffer-history-search-history)
757 (error "No previous history search regexp"))
c1172a19 758 regexp)
854c16c5 759 (prefix-numeric-value current-prefix-arg))))
e276a14a
MB
760 (unless (zerop n)
761 (if (and (zerop minibuffer-history-position)
762 (null minibuffer-text-before-history))
763 (setq minibuffer-text-before-history (field-string (point-max))))
764 (let ((history (symbol-value minibuffer-history-variable))
765 (case-fold-search
766 (if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
767 ;; On some systems, ignore case for file names.
768 (if (memq minibuffer-history-variable
769 minibuffer-history-case-insensitive-variables)
770 t
771 ;; Respect the user's setting for case-fold-search:
772 case-fold-search)
773 nil))
774 prevpos
775 match-string
776 match-offset
777 (pos minibuffer-history-position))
778 (while (/= n 0)
779 (setq prevpos pos)
780 (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
781 (when (= pos prevpos)
e91f80c4 782 (error (if (= pos 1)
ccc58657
RS
783 "No later matching history item"
784 "No earlier matching history item")))
e276a14a
MB
785 (setq match-string
786 (if (eq minibuffer-history-sexp-flag (minibuffer-depth))
7908d27c 787 (let ((print-level nil))
e276a14a
MB
788 (prin1-to-string (nth (1- pos) history)))
789 (nth (1- pos) history)))
790 (setq match-offset
791 (if (< n 0)
792 (and (string-match regexp match-string)
793 (match-end 0))
794 (and (string-match (concat ".*\\(" regexp "\\)") match-string)
795 (match-beginning 1))))
796 (when match-offset
797 (setq n (+ n (if (< n 0) 1 -1)))))
798 (setq minibuffer-history-position pos)
799 (goto-char (point-max))
800 (delete-field)
801 (insert match-string)
802 (goto-char (+ (field-beginning) match-offset))))
854c16c5
RS
803 (if (or (eq (car (car command-history)) 'previous-matching-history-element)
804 (eq (car (car command-history)) 'next-matching-history-element))
805 (setq command-history (cdr command-history))))
e91f80c4 806
e91f80c4 807(defun next-matching-history-element (regexp n)
854c16c5
RS
808 "Find the next history element that matches REGEXP.
809\(The next history element refers to a more recent action.)
810With prefix argument N, search for Nth next match.
5c2010f0 811If N is negative, find the previous or Nth previous match.
9889af08
EZ
812Normally, history elements are matched case-insensitively if
813`case-fold-search' is non-nil, but an uppercase letter in REGEXP
814makes the search case-sensitive."
854c16c5 815 (interactive
c1172a19 816 (let* ((enable-recursive-minibuffers t)
c1172a19
RS
817 (regexp (read-from-minibuffer "Next element matching (regexp): "
818 nil
819 minibuffer-local-map
820 nil
821 'minibuffer-history-search-history)))
822 ;; Use the last regexp specified, by default, if input is empty.
823 (list (if (string= regexp "")
824 (setcar minibuffer-history-search-history
825 (nth 1 minibuffer-history-search-history))
826 regexp)
854c16c5 827 (prefix-numeric-value current-prefix-arg))))
e91f80c4 828 (previous-matching-history-element regexp (- n)))
2076c87c 829
8dc3ba7d
MB
830(defvar minibuffer-temporary-goal-position nil)
831
ebb61177
RS
832(defun next-history-element (n)
833 "Insert the next element of the minibuffer history into the minibuffer."
2076c87c 834 (interactive "p")
0818b15e 835 (or (zerop n)
93cee14b
RS
836 (let ((narg (- minibuffer-history-position n))
837 (minimum (if minibuffer-default -1 0))
068c712c 838 elt minibuffer-returned-to-present)
93cee14b
RS
839 (if (and (zerop minibuffer-history-position)
840 (null minibuffer-text-before-history))
a4d1159b 841 (setq minibuffer-text-before-history (field-string (point-max))))
93cee14b 842 (if (< narg minimum)
81091543
RS
843 (if minibuffer-default
844 (error "End of history; no next item")
845 (error "End of history; no default available")))
93cee14b
RS
846 (if (> narg (length (symbol-value minibuffer-history-variable)))
847 (error "Beginning of history; no preceding item"))
8dc3ba7d
MB
848 (unless (or (eq last-command 'next-history-element)
849 (eq last-command 'previous-history-element))
850 (let ((prompt-end (field-beginning (point-max))))
851 (set (make-local-variable 'minibuffer-temporary-goal-position)
852 (cond ((<= (point) prompt-end) prompt-end)
853 ((eobp) nil)
854 (t (point))))))
a4d1159b 855 (goto-char (point-max))
12de1411 856 (delete-field)
93cee14b
RS
857 (setq minibuffer-history-position narg)
858 (cond ((= narg -1)
859 (setq elt minibuffer-default))
860 ((= narg 0)
54c548db 861 (setq elt (or minibuffer-text-before-history ""))
068c712c 862 (setq minibuffer-returned-to-present t)
93cee14b
RS
863 (setq minibuffer-text-before-history nil))
864 (t (setq elt (nth (1- minibuffer-history-position)
865 (symbol-value minibuffer-history-variable)))))
866 (insert
068c712c
KH
867 (if (and (eq minibuffer-history-sexp-flag (minibuffer-depth))
868 (not minibuffer-returned-to-present))
93cee14b
RS
869 (let ((print-level nil))
870 (prin1-to-string elt))
871 elt))
8dc3ba7d 872 (goto-char (or minibuffer-temporary-goal-position (point-max))))))
2076c87c 873
ebb61177 874(defun previous-history-element (n)
3ee3a076 875 "Inserts the previous element of the minibuffer history into the minibuffer."
2076c87c 876 (interactive "p")
2c5e21c1 877 (next-history-element (- n)))
d0678801
RM
878
879(defun next-complete-history-element (n)
a4d1159b
GM
880 "Get next history element which completes the minibuffer before the point.
881The contents of the minibuffer after the point are deleted, and replaced
882by the new completion."
d0678801 883 (interactive "p")
b5e6f936
RM
884 (let ((point-at-start (point)))
885 (next-matching-history-element
a4d1159b
GM
886 (concat
887 "^" (regexp-quote (buffer-substring (field-beginning) (point))))
888 n)
b5e6f936
RM
889 ;; next-matching-history-element always puts us at (point-min).
890 ;; Move to the position we were at before changing the buffer contents.
891 ;; This is still sensical, because the text before point has not changed.
892 (goto-char point-at-start)))
d0678801
RM
893
894(defun previous-complete-history-element (n)
1f6fcec3 895 "\
a4d1159b
GM
896Get previous history element which completes the minibuffer before the point.
897The contents of the minibuffer after the point are deleted, and replaced
898by the new completion."
d0678801
RM
899 (interactive "p")
900 (next-complete-history-element (- n)))
a4d1159b
GM
901
902;; These two functions are for compatibility with the old subrs of the
903;; same name.
904
905(defun minibuffer-prompt-width ()
906 "Return the display width of the minibuffer prompt.
907Return 0 if current buffer is not a mini-buffer."
908 ;; Return the width of everything before the field at the end of
909 ;; the buffer; this should be 0 for normal buffers.
910 (1- (field-beginning (point-max))))
911
912(defun minibuffer-prompt-end ()
913 "Return the buffer position of the end of the minibuffer prompt.
b90d06b0 914Return (point-min) if current buffer is not a mini-buffer."
bf2083f9
GM
915 (field-beginning (point-max)))
916
b90d06b0
MB
917(defun minibuffer-contents ()
918 "Return the user input in a minbuffer as a string.
919The current buffer must be a minibuffer."
920 (field-string (point-max)))
921
922(defun minibuffer-contents-no-properties ()
923 "Return the user input in a minbuffer as a string, without text-properties.
924The current buffer must be a minibuffer."
925 (field-string-no-properties (point-max)))
926
927(defun delete-minibuffer-contents ()
928 "Delete all user input in a minibuffer.
929The current buffer must be a minibuffer."
930 (delete-field (point-max)))
eaae8106 931
2076c87c 932;Put this on C-x u, so we can force that rather than C-_ into startup msg
e462e42f 933(defalias 'advertised-undo 'undo)
2076c87c
JB
934
935(defun undo (&optional arg)
936 "Undo some previous changes.
937Repeat this command to undo more changes.
65627aad
RS
938A numeric argument serves as a repeat count.
939
3c1b77ca
MB
940In Transient Mark mode when the mark is active, only undo changes within
941the current region. Similarly, when not in Transient Mark mode, just C-u
942as an argument limits undo to changes within the current region."
65627aad 943 (interactive "*P")
456c617c
RS
944 ;; If we don't get all the way thru, make last-command indicate that
945 ;; for the following command.
946 (setq this-command t)
b553cffa
RS
947 (let ((modified (buffer-modified-p))
948 (recent-save (recent-auto-save-p)))
71e40adf
JB
949 (or (eq (selected-window) (minibuffer-window))
950 (message "Undo!"))
3c1b77ca
MB
951 (unless (eq last-command 'undo)
952 (if (if transient-mark-mode mark-active (and arg (not (numberp arg))))
953 (undo-start (region-beginning) (region-end))
954 (undo-start))
955 ;; get rid of initial undo boundary
956 (undo-more 1))
957 (undo-more
958 (if (or transient-mark-mode (numberp arg))
959 (prefix-numeric-value arg)
960 1))
2512c9f0
RS
961 ;; Don't specify a position in the undo record for the undo command.
962 ;; Instead, undoing this should move point to where the change is.
963 (let ((tail buffer-undo-list)
003550c5
GM
964 (prev nil))
965 (while (car tail)
966 (when (integerp (car tail))
967 (let ((pos (car tail)))
968 (if (null prev)
969 (setq buffer-undo-list (cdr tail))
970 (setcdr prev (cdr tail)))
971 (setq tail (cdr tail))
972 (while (car tail)
973 (if (eq pos (car tail))
974 (if prev
975 (setcdr prev (cdr tail))
976 (setq buffer-undo-list (cdr tail)))
977 (setq prev tail))
978 (setq tail (cdr tail)))
979 (setq tail nil)))
980 (setq prev tail tail (cdr tail))))
981
2076c87c 982 (and modified (not (buffer-modified-p))
456c617c
RS
983 (delete-auto-save-file-if-necessary recent-save)))
984 ;; If we do get all the way thru, make this-command indicate that.
985 (setq this-command 'undo))
2076c87c 986
278b0a58
RS
987(defvar pending-undo-list nil
988 "Within a run of consecutive undo commands, list remaining to be undone.")
989
52d1110d
RS
990(defvar undo-in-progress nil
991 "Non-nil while performing an undo.
992Some change-hooks test this variable to do something different.")
993
2076c87c
JB
994(defun undo-more (count)
995 "Undo back N undo-boundaries beyond what was already undone recently.
ff1fbe3e
RS
996Call `undo-start' to get ready to undo recent changes,
997then call `undo-more' one or more times to undo them."
2076c87c
JB
998 (or pending-undo-list
999 (error "No further undo information"))
52d1110d
RS
1000 (let ((undo-in-progress t))
1001 (setq pending-undo-list (primitive-undo count pending-undo-list))))
2076c87c 1002
65627aad
RS
1003;; Deep copy of a list
1004(defun undo-copy-list (list)
1005 "Make a copy of undo list LIST."
1006 (mapcar 'undo-copy-list-1 list))
1007
1008(defun undo-copy-list-1 (elt)
1009 (if (consp elt)
1010 (cons (car elt) (undo-copy-list-1 (cdr elt)))
1011 elt))
1012
1013(defun undo-start (&optional beg end)
1014 "Set `pending-undo-list' to the front of the undo list.
1015The next call to `undo-more' will undo the most recently made change.
1016If BEG and END are specified, then only undo elements
1017that apply to text between BEG and END are used; other undo elements
1018are ignored. If BEG and END are nil, all undo elements are used."
1019 (if (eq buffer-undo-list t)
1020 (error "No undo information in this buffer"))
1e722f9f 1021 (setq pending-undo-list
65627aad
RS
1022 (if (and beg end (not (= beg end)))
1023 (undo-make-selective-list (min beg end) (max beg end))
1024 buffer-undo-list)))
1025
1026(defvar undo-adjusted-markers)
1027
1028(defun undo-make-selective-list (start end)
1029 "Return a list of undo elements for the region START to END.
1030The elements come from `buffer-undo-list', but we keep only
1031the elements inside this region, and discard those outside this region.
1032If we find an element that crosses an edge of this region,
1033we stop and ignore all further elements."
1034 (let ((undo-list-copy (undo-copy-list buffer-undo-list))
1035 (undo-list (list nil))
1036 undo-adjusted-markers
1037 some-rejected
1038 undo-elt undo-elt temp-undo-list delta)
1039 (while undo-list-copy
1040 (setq undo-elt (car undo-list-copy))
1041 (let ((keep-this
1042 (cond ((and (consp undo-elt) (eq (car undo-elt) t))
1043 ;; This is a "was unmodified" element.
1044 ;; Keep it if we have kept everything thus far.
1045 (not some-rejected))
1046 (t
1047 (undo-elt-in-region undo-elt start end)))))
1048 (if keep-this
1049 (progn
1050 (setq end (+ end (cdr (undo-delta undo-elt))))
1051 ;; Don't put two nils together in the list
1052 (if (not (and (eq (car undo-list) nil)
1053 (eq undo-elt nil)))
1054 (setq undo-list (cons undo-elt undo-list))))
1055 (if (undo-elt-crosses-region undo-elt start end)
1056 (setq undo-list-copy nil)
1057 (setq some-rejected t)
1058 (setq temp-undo-list (cdr undo-list-copy))
1059 (setq delta (undo-delta undo-elt))
1060
1061 (when (/= (cdr delta) 0)
1062 (let ((position (car delta))
1063 (offset (cdr delta)))
1064
1065 ;; Loop down the earlier events adjusting their buffer positions
1066 ;; to reflect the fact that a change to the buffer isn't being
1067 ;; undone. We only need to process those element types which
1068 ;; undo-elt-in-region will return as being in the region since
1069 ;; only those types can ever get into the output
1070
1071 (while temp-undo-list
1072 (setq undo-elt (car temp-undo-list))
1073 (cond ((integerp undo-elt)
1074 (if (>= undo-elt position)
1075 (setcar temp-undo-list (- undo-elt offset))))
1076 ((atom undo-elt) nil)
1077 ((stringp (car undo-elt))
1078 ;; (TEXT . POSITION)
1079 (let ((text-pos (abs (cdr undo-elt)))
1080 (point-at-end (< (cdr undo-elt) 0 )))
1081 (if (>= text-pos position)
1e722f9f 1082 (setcdr undo-elt (* (if point-at-end -1 1)
65627aad
RS
1083 (- text-pos offset))))))
1084 ((integerp (car undo-elt))
1085 ;; (BEGIN . END)
1086 (when (>= (car undo-elt) position)
1087 (setcar undo-elt (- (car undo-elt) offset))
1088 (setcdr undo-elt (- (cdr undo-elt) offset))))
1089 ((null (car undo-elt))
1090 ;; (nil PROPERTY VALUE BEG . END)
1091 (let ((tail (nthcdr 3 undo-elt)))
1092 (when (>= (car tail) position)
1093 (setcar tail (- (car tail) offset))
1094 (setcdr tail (- (cdr tail) offset))))))
1095 (setq temp-undo-list (cdr temp-undo-list))))))))
1096 (setq undo-list-copy (cdr undo-list-copy)))
1097 (nreverse undo-list)))
1098
1099(defun undo-elt-in-region (undo-elt start end)
1100 "Determine whether UNDO-ELT falls inside the region START ... END.
1101If it crosses the edge, we return nil."
1102 (cond ((integerp undo-elt)
1103 (and (>= undo-elt start)
1104 (< undo-elt end)))
1105 ((eq undo-elt nil)
1106 t)
1107 ((atom undo-elt)
1108 nil)
1109 ((stringp (car undo-elt))
1110 ;; (TEXT . POSITION)
1111 (and (>= (abs (cdr undo-elt)) start)
1112 (< (abs (cdr undo-elt)) end)))
1113 ((and (consp undo-elt) (markerp (car undo-elt)))
1114 ;; This is a marker-adjustment element (MARKER . ADJUSTMENT).
1115 ;; See if MARKER is inside the region.
1116 (let ((alist-elt (assq (car undo-elt) undo-adjusted-markers)))
1117 (unless alist-elt
1118 (setq alist-elt (cons (car undo-elt)
1119 (marker-position (car undo-elt))))
1120 (setq undo-adjusted-markers
1121 (cons alist-elt undo-adjusted-markers)))
1122 (and (cdr alist-elt)
1123 (>= (cdr alist-elt) start)
1124 (< (cdr alist-elt) end))))
1125 ((null (car undo-elt))
1126 ;; (nil PROPERTY VALUE BEG . END)
1127 (let ((tail (nthcdr 3 undo-elt)))
1128 (and (>= (car tail) start)
1129 (< (cdr tail) end))))
1130 ((integerp (car undo-elt))
1131 ;; (BEGIN . END)
1132 (and (>= (car undo-elt) start)
1133 (< (cdr undo-elt) end)))))
1134
1135(defun undo-elt-crosses-region (undo-elt start end)
1136 "Test whether UNDO-ELT crosses one edge of that region START ... END.
1137This assumes we have already decided that UNDO-ELT
1138is not *inside* the region START...END."
1139 (cond ((atom undo-elt) nil)
1140 ((null (car undo-elt))
1141 ;; (nil PROPERTY VALUE BEG . END)
1142 (let ((tail (nthcdr 3 undo-elt)))
1143 (not (or (< (car tail) end)
1144 (> (cdr tail) start)))))
1145 ((integerp (car undo-elt))
1146 ;; (BEGIN . END)
1147 (not (or (< (car undo-elt) end)
1148 (> (cdr undo-elt) start))))))
1149
1150;; Return the first affected buffer position and the delta for an undo element
1151;; delta is defined as the change in subsequent buffer positions if we *did*
1152;; the undo.
1153(defun undo-delta (undo-elt)
1154 (if (consp undo-elt)
1155 (cond ((stringp (car undo-elt))
1156 ;; (TEXT . POSITION)
1157 (cons (abs (cdr undo-elt)) (length (car undo-elt))))
1158 ((integerp (car undo-elt))
1159 ;; (BEGIN . END)
1160 (cons (car undo-elt) (- (car undo-elt) (cdr undo-elt))))
1161 (t
1162 '(0 . 0)))
1163 '(0 . 0)))
eaae8106 1164
009ef402
RS
1165(defvar shell-command-history nil
1166 "History list for some commands that read shell commands.")
1167
59fc41e5
RS
1168(defvar shell-command-switch "-c"
1169 "Switch used to have the shell execute its command line argument.")
1170
cc039f78
KH
1171(defvar shell-command-default-error-buffer nil
1172 "*Buffer name for `shell-command' and `shell-command-on-region' error output.
1173This buffer is used when `shell-command' or 'shell-command-on-region'
1174is run interactively. A value of nil means that output to stderr and
1175stdout will be intermixed in the output stream.")
1176
1177(defun shell-command (command &optional output-buffer error-buffer)
2076c87c 1178 "Execute string COMMAND in inferior shell; display output, if any.
0b3f96d4 1179With prefix argument, insert the COMMAND's output at point.
d382f610 1180
2076c87c 1181If COMMAND ends in ampersand, execute it asynchronously.
d382f610 1182The output appears in the buffer `*Async Shell Command*'.
bcad4985 1183That buffer is in shell mode.
d382f610 1184
939ac10c
GM
1185Otherwise, COMMAND is executed synchronously. The output appears in
1186the buffer `*Shell Command Output*'. If the output is short enough to
1187display in the echo area (which is determined by the variables
1188`resize-mini-windows' and `max-mini-window-height'), it is shown
1189there, but it is nonetheless available in buffer `*Shell Command
1190Output*' even though that buffer is not automatically displayed. If
1191there is no output, or if output is inserted in the current buffer,
1192then `*Shell Command Output*' is deleted.
d0d74413 1193
07f458c1
RS
1194To specify a coding system for converting non-ASCII characters
1195in the shell command output, use \\[universal-coding-system-argument]
1196before this command.
1197
1198Noninteractive callers can specify coding systems by binding
1199`coding-system-for-read' and `coding-system-for-write'.
1200
d0d74413
RS
1201The optional second argument OUTPUT-BUFFER, if non-nil,
1202says to put the output in some other buffer.
1203If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
1204If OUTPUT-BUFFER is not a buffer and not nil,
1205insert output in current buffer. (This cannot be done asynchronously.)
cc039f78
KH
1206In either case, the output is inserted after point (leaving mark after it).
1207
1208If the optional third argument ERROR-BUFFER is non-nil, it is a buffer
1209or buffer name to which to direct the command's standard error output.
1210If it is nil, error output is mingled with regular output.
1211In an interactive call, the variable `shell-command-default-error-buffer'
1212specifies the value of ERROR-BUFFER."
1213
aa00b92d
RS
1214 (interactive (list (read-from-minibuffer "Shell command: "
1215 nil nil nil 'shell-command-history)
cc039f78
KH
1216 current-prefix-arg
1217 shell-command-default-error-buffer))
c7edd03c
KH
1218 ;; Look for a handler in case default-directory is a remote file name.
1219 (let ((handler
1220 (find-file-name-handler (directory-file-name default-directory)
1221 'shell-command)))
1222 (if handler
cc039f78 1223 (funcall handler 'shell-command command output-buffer error-buffer)
c7edd03c
KH
1224 (if (and output-buffer
1225 (not (or (bufferp output-buffer) (stringp output-buffer))))
cc039f78 1226 (let ((error-file
1e722f9f 1227 (if error-buffer
b005abd5 1228 (make-temp-file
171a45d9
EZ
1229 (expand-file-name "scor"
1230 (or small-temporary-file-directory
1231 temporary-file-directory)))
cc039f78
KH
1232 nil)))
1233 (barf-if-buffer-read-only)
63437623 1234 (push-mark nil t)
cc039f78
KH
1235 ;; We do not use -f for csh; we will not support broken use of
1236 ;; .cshrcs. Even the BSD csh manual says to use
1237 ;; "if ($?prompt) exit" before things which are not useful
1238 ;; non-interactively. Besides, if someone wants their other
1239 ;; aliases for shell commands then they can still have them.
1e722f9f 1240 (call-process shell-file-name nil
cc039f78
KH
1241 (if error-file
1242 (list t error-file)
1243 t)
1244 nil shell-command-switch command)
1245 (when (and error-file (file-exists-p error-file))
1246 (if (< 0 (nth 7 (file-attributes error-file)))
1247 (with-current-buffer (get-buffer-create error-buffer)
1248 (let ((pos-from-end (- (point-max) (point))))
1249 (or (bobp)
1250 (insert "\f\n"))
1251 ;; Do no formatting while reading error file,
1252 ;; because that can run a shell command, and we
1253 ;; don't want that to cause an infinite recursion.
1254 (format-insert-file error-file nil)
1255 ;; Put point after the inserted errors.
1256 (goto-char (- (point-max) pos-from-end)))
1257 (display-buffer (current-buffer))))
1258 (delete-file error-file))
1259 ;; This is like exchange-point-and-mark, but doesn't
1260 ;; activate the mark. It is cleaner to avoid activation,
1261 ;; even though the command loop would deactivate the mark
1262 ;; because we inserted text.
1263 (goto-char (prog1 (mark t)
1264 (set-marker (mark-marker) (point)
1265 (current-buffer)))))
c7edd03c
KH
1266 ;; Preserve the match data in case called from a program.
1267 (save-match-data
1268 (if (string-match "[ \t]*&[ \t]*$" command)
1269 ;; Command ending with ampersand means asynchronous.
1270 (let ((buffer (get-buffer-create
1271 (or output-buffer "*Async Shell Command*")))
1272 (directory default-directory)
1273 proc)
1274 ;; Remove the ampersand.
1275 (setq command (substring command 0 (match-beginning 0)))
1276 ;; If will kill a process, query first.
1277 (setq proc (get-buffer-process buffer))
1278 (if proc
1279 (if (yes-or-no-p "A command is running. Kill it? ")
1280 (kill-process proc)
1281 (error "Shell command in progress")))
1282 (save-excursion
1283 (set-buffer buffer)
1284 (setq buffer-read-only nil)
1285 (erase-buffer)
1286 (display-buffer buffer)
1287 (setq default-directory directory)
1e722f9f 1288 (setq proc (start-process "Shell" buffer shell-file-name
c7edd03c
KH
1289 shell-command-switch command))
1290 (setq mode-line-process '(":%s"))
1291 (require 'shell) (shell-mode)
1292 (set-process-sentinel proc 'shell-command-sentinel)
1293 ))
cc039f78
KH
1294 (shell-command-on-region (point) (point) command
1295 output-buffer nil error-buffer)))))))
eaae8106 1296
f69aad2b
MB
1297(defun display-message-or-buffer (message
1298 &optional buffer-name not-this-window frame)
1299 "Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer.
1300MESSAGE may be either a string or a buffer.
1301
1302A buffer is displayed using `display-buffer' if MESSAGE is too long for
939ac10c
GM
1303the maximum height of the echo area, as defined by `max-mini-window-height'
1304if `resize-mini-windows' is non-nil.
f69aad2b 1305
2a3f00bf
MB
1306Returns either the string shown in the echo area, or when a pop-up
1307buffer is used, the window used to display it.
1308
f69aad2b
MB
1309If MESSAGE is a string, then the optional argument BUFFER-NAME is the
1310name of the buffer used to display it in the case where a pop-up buffer
1311is used, defaulting to `*Message*'. In the case where MESSAGE is a
1312string and it is displayed in the echo area, it is not specified whether
1313the contents are inserted into the buffer anyway.
1314
1315Optional arguments NOT-THIS-WINDOW and FRAME are as for `display-buffer',
1316and only used if a buffer is displayed."
1317 (cond ((and (stringp message) (not (string-match "\n" message)))
1318 ;; Trivial case where we can use the echo area
1319 (message "%s" message))
1320 ((and (stringp message)
1321 (= (string-match "\n" message) (1- (length message))))
1322 ;; Trivial case where we can just remove single trailing newline
1323 (message "%s" (substring message 0 (1- (length message)))))
1324 (t
1325 ;; General case
1326 (with-current-buffer
1327 (if (bufferp message)
1328 message
1329 (get-buffer-create (or buffer-name "*Message*")))
1330
1331 (unless (bufferp message)
1332 (erase-buffer)
1333 (insert message))
1334
1335 (let ((lines
1336 (if (= (buffer-size) 0)
1337 0
1338 (count-lines (point-min) (point-max)))))
1339 (cond ((or (<= lines 1)
1340 (<= lines
939ac10c
GM
1341 (if resize-mini-windows
1342 (cond ((floatp max-mini-window-height)
1343 (* (frame-height)
1344 max-mini-window-height))
1345 ((integerp max-mini-window-height)
1346 max-mini-window-height)
1347 (t
1348 1))
1349 1)))
f69aad2b
MB
1350 ;; Echo area
1351 (goto-char (point-max))
1352 (when (bolp)
1353 (backward-char 1))
1354 (message "%s" (buffer-substring (point-min) (point))))
1355 (t
1356 ;; Buffer
1357 (goto-char (point-min))
1358 (display-buffer message not-this-window frame))))))))
1359
1360
2076c87c
JB
1361;; We have a sentinel to prevent insertion of a termination message
1362;; in the buffer itself.
1363(defun shell-command-sentinel (process signal)
bcad4985 1364 (if (memq (process-status process) '(exit signal))
1e722f9f 1365 (message "%s: %s."
bcad4985
KH
1366 (car (cdr (cdr (process-command process))))
1367 (substring signal 0 -1))))
2076c87c 1368
d0d74413 1369(defun shell-command-on-region (start end command
cce1c318
RS
1370 &optional output-buffer replace
1371 error-buffer)
2076c87c
JB
1372 "Execute string COMMAND in inferior shell with region as input.
1373Normally display output (if any) in temp buffer `*Shell Command Output*';
a0184aeb
DL
1374Prefix arg means replace the region with it. Return the exit code of
1375COMMAND.
56c0450e 1376
07f458c1
RS
1377To specify a coding system for converting non-ASCII characters
1378in the input and output to the shell command, use \\[universal-coding-system-argument]
1379before this command. By default, the input (from the current buffer)
1380is encoded in the same coding system that will be used to save the file,
1381`buffer-file-coding-system'. If the output is going to replace the region,
1382then it is decoded from that same coding system.
1383
8923a211
RS
1384The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER,
1385REPLACE, ERROR-BUFFER. Noninteractive callers can specify coding
1386systems by binding `coding-system-for-read' and
1387`coding-system-for-write'.
2076c87c 1388
06933804 1389If the output is short enough to display in the echo area (which is
939ac10c
GM
1390determined by the variable `max-mini-window-height' if
1391`resize-mini-windows' is non-nil), it is shown there, but it is
1392nonetheless available in buffer `*Shell Command Output*' even though
1393that buffer is not automatically displayed. If there is no output, or
1394if output is inserted in the current buffer, then `*Shell Command
1395Output*' is deleted.
d0d74413 1396
56c0450e
RS
1397If the optional fourth argument OUTPUT-BUFFER is non-nil,
1398that says to put the output in some other buffer.
d0d74413
RS
1399If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
1400If OUTPUT-BUFFER is not a buffer and not nil,
1401insert output in the current buffer.
cce1c318
RS
1402In either case, the output is inserted after point (leaving mark after it).
1403
8923a211
RS
1404If REPLACE, the optional fifth argument, is non-nil, that means insert
1405the output in place of text from START to END, putting point and mark
1406around it.
1407
b735c991 1408If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
cce1c318 1409or buffer name to which to direct the command's standard error output.
7fd47839 1410If it is nil, error output is mingled with regular output.
cc039f78
KH
1411In an interactive call, the variable `shell-command-default-error-buffer'
1412specifies the value of ERROR-BUFFER."
cae49185
RS
1413 (interactive (let ((string
1414 ;; Do this before calling region-beginning
1415 ;; and region-end, in case subprocess output
1416 ;; relocates them while we are in the minibuffer.
1417 (read-from-minibuffer "Shell command on region: "
1418 nil nil nil
1419 'shell-command-history)))
2b03c506
RS
1420 ;; call-interactively recognizes region-beginning and
1421 ;; region-end specially, leaving them in the history.
1422 (list (region-beginning) (region-end)
cae49185
RS
1423 string
1424 current-prefix-arg
7fd47839 1425 current-prefix-arg
cc039f78 1426 shell-command-default-error-buffer)))
cce1c318 1427 (let ((error-file
171a45d9 1428 (if error-buffer
b005abd5 1429 (make-temp-file
171a45d9
EZ
1430 (expand-file-name "scor"
1431 (or small-temporary-file-directory
1432 temporary-file-directory)))
a0184aeb
DL
1433 nil))
1434 exit-status)
7fd47839
RS
1435 (if (or replace
1436 (and output-buffer
748d6ca4 1437 (not (or (bufferp output-buffer) (stringp output-buffer)))))
7fd47839
RS
1438 ;; Replace specified region with output from command.
1439 (let ((swap (and replace (< start end))))
1440 ;; Don't muck with mark unless REPLACE says we should.
1441 (goto-char start)
1442 (and replace (push-mark))
a0184aeb
DL
1443 (setq exit-status
1444 (call-process-region start end shell-file-name t
1445 (if error-file
1446 (list t error-file)
1447 t)
1448 nil shell-command-switch command))
fd344fb7
RS
1449;;; It is rude to delete a buffer which the command is not using.
1450;;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
1451;;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
1452;;; (kill-buffer shell-buffer)))
7fd47839
RS
1453 ;; Don't muck with mark unless REPLACE says we should.
1454 (and replace swap (exchange-point-and-mark)))
1455 ;; No prefix argument: put the output in a temp buffer,
1456 ;; replacing its entire contents.
1457 (let ((buffer (get-buffer-create
1458 (or output-buffer "*Shell Command Output*")))
a0184aeb 1459 (success nil))
7fd47839
RS
1460 (unwind-protect
1461 (if (eq buffer (current-buffer))
1462 ;; If the input is the same buffer as the output,
1463 ;; delete everything but the specified region,
1464 ;; then replace that region with the output.
1465 (progn (setq buffer-read-only nil)
1466 (delete-region (max start end) (point-max))
1467 (delete-region (point-min) (min start end))
1468 (setq exit-status
1469 (call-process-region (point-min) (point-max)
1e722f9f 1470 shell-file-name t
7fd47839
RS
1471 (if error-file
1472 (list t error-file)
1473 t)
a0184aeb
DL
1474 nil shell-command-switch
1475 command)))
1476 ;; Clear the output buffer, then run the command with
1477 ;; output there.
c2e303c8
GM
1478 (let ((directory default-directory))
1479 (save-excursion
1480 (set-buffer buffer)
1481 (setq buffer-read-only nil)
1482 (if (not output-buffer)
1483 (setq default-directory directory))
1484 (erase-buffer)))
7fd47839
RS
1485 (setq exit-status
1486 (call-process-region start end shell-file-name nil
1487 (if error-file
1488 (list buffer error-file)
1489 buffer)
a0184aeb 1490 nil shell-command-switch command)))
a92da273 1491 (setq success (and exit-status (equal 0 exit-status)))
7fd47839 1492 ;; Report the amount of output.
f69aad2b
MB
1493 (if (with-current-buffer buffer (> (point-max) (point-min)))
1494 ;; There's some output, display it
1495 (display-message-or-buffer buffer)
1496 ;; No output; error?
1497 (message (if (and error-file
1498 (< 0 (nth 7 (file-attributes error-file))))
1499 "(Shell command %sed with some error output)"
1500 "(Shell command %sed with no output)")
fd344fb7 1501 (if (equal 0 exit-status) "succeed" "fail"))))))
f69aad2b 1502
cc039f78
KH
1503 (when (and error-file (file-exists-p error-file))
1504 (if (< 0 (nth 7 (file-attributes error-file)))
1505 (with-current-buffer (get-buffer-create error-buffer)
1506 (let ((pos-from-end (- (point-max) (point))))
1507 (or (bobp)
1508 (insert "\f\n"))
1509 ;; Do no formatting while reading error file,
1510 ;; because that can run a shell command, and we
1511 ;; don't want that to cause an infinite recursion.
1512 (format-insert-file error-file nil)
1513 ;; Put point after the inserted errors.
1514 (goto-char (- (point-max) pos-from-end)))
1515 (display-buffer (current-buffer))))
1516 (delete-file error-file))
a0184aeb 1517 exit-status))
1e722f9f 1518
d589bd99
RS
1519(defun shell-command-to-string (command)
1520 "Execute shell command COMMAND and return its output as a string."
1521 (with-output-to-string
17cc9013
RS
1522 (with-current-buffer
1523 standard-output
1524 (call-process shell-file-name nil t nil shell-command-switch command))))
eaae8106 1525
1b43f83f 1526(defvar universal-argument-map
69d4c3c4
KH
1527 (let ((map (make-sparse-keymap)))
1528 (define-key map [t] 'universal-argument-other-key)
b9ff190d 1529 (define-key map (vector meta-prefix-char t) 'universal-argument-other-key)
69d4c3c4
KH
1530 (define-key map [switch-frame] nil)
1531 (define-key map [?\C-u] 'universal-argument-more)
1532 (define-key map [?-] 'universal-argument-minus)
1533 (define-key map [?0] 'digit-argument)
1534 (define-key map [?1] 'digit-argument)
1535 (define-key map [?2] 'digit-argument)
1536 (define-key map [?3] 'digit-argument)
1537 (define-key map [?4] 'digit-argument)
1538 (define-key map [?5] 'digit-argument)
1539 (define-key map [?6] 'digit-argument)
1540 (define-key map [?7] 'digit-argument)
1541 (define-key map [?8] 'digit-argument)
1542 (define-key map [?9] 'digit-argument)
bd7acc8d
GM
1543 (define-key map [kp-0] 'digit-argument)
1544 (define-key map [kp-1] 'digit-argument)
1545 (define-key map [kp-2] 'digit-argument)
1546 (define-key map [kp-3] 'digit-argument)
1547 (define-key map [kp-4] 'digit-argument)
1548 (define-key map [kp-5] 'digit-argument)
1549 (define-key map [kp-6] 'digit-argument)
1550 (define-key map [kp-7] 'digit-argument)
1551 (define-key map [kp-8] 'digit-argument)
1552 (define-key map [kp-9] 'digit-argument)
1553 (define-key map [kp-subtract] 'universal-argument-minus)
69d4c3c4
KH
1554 map)
1555 "Keymap used while processing \\[universal-argument].")
1556
0de84e16
RS
1557(defvar universal-argument-num-events nil
1558 "Number of argument-specifying events read by `universal-argument'.
1559`universal-argument-other-key' uses this to discard those events
1560from (this-command-keys), and reread only the final command.")
1561
e8d1a377
KH
1562(defun universal-argument ()
1563 "Begin a numeric argument for the following command.
1564Digits or minus sign following \\[universal-argument] make up the numeric argument.
1565\\[universal-argument] following the digits or minus sign ends the argument.
1566\\[universal-argument] without digits or minus sign provides 4 as argument.
1567Repeating \\[universal-argument] without digits or minus sign
0565d307
RS
1568 multiplies the argument by 4 each time.
1569For some commands, just \\[universal-argument] by itself serves as a flag
a697fc62
RS
1570which is different in effect from any particular numeric argument.
1571These commands include \\[set-mark-command] and \\[start-kbd-macro]."
69d4c3c4
KH
1572 (interactive)
1573 (setq prefix-arg (list 4))
0de84e16 1574 (setq universal-argument-num-events (length (this-command-keys)))
69d4c3c4 1575 (setq overriding-terminal-local-map universal-argument-map))
e8d1a377 1576
69d4c3c4
KH
1577;; A subsequent C-u means to multiply the factor by 4 if we've typed
1578;; nothing but C-u's; otherwise it means to terminate the prefix arg.
1579(defun universal-argument-more (arg)
e8d1a377 1580 (interactive "P")
69d4c3c4
KH
1581 (if (consp arg)
1582 (setq prefix-arg (list (* 4 (car arg))))
1cd24721
RS
1583 (if (eq arg '-)
1584 (setq prefix-arg (list -4))
1585 (setq prefix-arg arg)
1586 (setq overriding-terminal-local-map nil)))
0de84e16 1587 (setq universal-argument-num-events (length (this-command-keys))))
e8d1a377
KH
1588
1589(defun negative-argument (arg)
1590 "Begin a negative numeric argument for the next command.
1591\\[universal-argument] following digits or minus sign ends the argument."
1592 (interactive "P")
69d4c3c4
KH
1593 (cond ((integerp arg)
1594 (setq prefix-arg (- arg)))
1595 ((eq arg '-)
1596 (setq prefix-arg nil))
1597 (t
b9ff190d 1598 (setq prefix-arg '-)))
0de84e16 1599 (setq universal-argument-num-events (length (this-command-keys)))
b9ff190d 1600 (setq overriding-terminal-local-map universal-argument-map))
69d4c3c4
KH
1601
1602(defun digit-argument (arg)
1603 "Part of the numeric argument for the next command.
1604\\[universal-argument] following digits or minus sign ends the argument."
1605 (interactive "P")
bd7acc8d
GM
1606 (let* ((char (if (integerp last-command-char)
1607 last-command-char
1608 (get last-command-char 'ascii-character)))
1609 (digit (- (logand char ?\177) ?0)))
69d4c3c4
KH
1610 (cond ((integerp arg)
1611 (setq prefix-arg (+ (* arg 10)
1612 (if (< arg 0) (- digit) digit))))
1613 ((eq arg '-)
1614 ;; Treat -0 as just -, so that -01 will work.
1615 (setq prefix-arg (if (zerop digit) '- (- digit))))
1616 (t
b9ff190d 1617 (setq prefix-arg digit))))
0de84e16 1618 (setq universal-argument-num-events (length (this-command-keys)))
b9ff190d 1619 (setq overriding-terminal-local-map universal-argument-map))
69d4c3c4
KH
1620
1621;; For backward compatibility, minus with no modifiers is an ordinary
1622;; command if digits have already been entered.
1623(defun universal-argument-minus (arg)
1624 (interactive "P")
1625 (if (integerp arg)
1626 (universal-argument-other-key arg)
1627 (negative-argument arg)))
1628
1629;; Anything else terminates the argument and is left in the queue to be
1630;; executed as a command.
1631(defun universal-argument-other-key (arg)
1632 (interactive "P")
1633 (setq prefix-arg arg)
0de84e16
RS
1634 (let* ((key (this-command-keys))
1635 (keylist (listify-key-sequence key)))
1636 (setq unread-command-events
06697cdb
RS
1637 (append (nthcdr universal-argument-num-events keylist)
1638 unread-command-events)))
f0ef2555 1639 (reset-this-command-lengths)
69d4c3c4 1640 (setq overriding-terminal-local-map nil))
eaae8106 1641
93be67de 1642;;;; Window system cut and paste hooks.
70e14c01
JB
1643
1644(defvar interprogram-cut-function nil
1645 "Function to call to make a killed region available to other programs.
1646
1647Most window systems provide some sort of facility for cutting and
9f112a3d
RS
1648pasting text between the windows of different programs.
1649This variable holds a function that Emacs calls whenever text
1650is put in the kill ring, to make the new kill available to other
70e14c01
JB
1651programs.
1652
9f112a3d
RS
1653The function takes one or two arguments.
1654The first argument, TEXT, is a string containing
1655the text which should be made available.
1656The second, PUSH, if non-nil means this is a \"new\" kill;
1657nil means appending to an \"old\" kill.")
70e14c01
JB
1658
1659(defvar interprogram-paste-function nil
1660 "Function to call to get text cut from other programs.
1661
1662Most window systems provide some sort of facility for cutting and
9f112a3d
RS
1663pasting text between the windows of different programs.
1664This variable holds a function that Emacs calls to obtain
70e14c01
JB
1665text that other programs have provided for pasting.
1666
1667The function should be called with no arguments. If the function
1668returns nil, then no other program has provided such text, and the top
1669of the Emacs kill ring should be used. If the function returns a
daa37602
JB
1670string, that string should be put in the kill ring as the latest kill.
1671
1672Note that the function should return a string only if a program other
1673than Emacs has provided a string for pasting; if Emacs provided the
1674most recent string, the function should return nil. If it is
1675difficult to tell whether Emacs or some other program provided the
1676current string, it is probably good enough to return nil if the string
1677is equal (according to `string=') to the last text Emacs provided.")
70e14c01
JB
1678
1679
eaae8106 1680
70e14c01 1681;;;; The kill ring data structure.
2076c87c
JB
1682
1683(defvar kill-ring nil
70e14c01
JB
1684 "List of killed text sequences.
1685Since the kill ring is supposed to interact nicely with cut-and-paste
1686facilities offered by window systems, use of this variable should
1687interact nicely with `interprogram-cut-function' and
1688`interprogram-paste-function'. The functions `kill-new',
1689`kill-append', and `current-kill' are supposed to implement this
1690interaction; you may want to use them instead of manipulating the kill
1691ring directly.")
2076c87c 1692
bffa4d92 1693(defcustom kill-ring-max 60
69c1dd37
RS
1694 "*Maximum length of kill ring before oldest elements are thrown away."
1695 :type 'integer
1696 :group 'killing)
2076c87c
JB
1697
1698(defvar kill-ring-yank-pointer nil
1699 "The tail of the kill ring whose car is the last thing yanked.")
1700
f914dc91 1701(defun kill-new (string &optional replace)
70e14c01
JB
1702 "Make STRING the latest kill in the kill ring.
1703Set the kill-ring-yank pointer to point to it.
f914dc91
KH
1704If `interprogram-cut-function' is non-nil, apply it to STRING.
1705Optional second argument REPLACE non-nil means that STRING will replace
1706the front of the kill ring, rather than being added to the list."
f1d01ba2
KH
1707 (and (fboundp 'menu-bar-update-yank-menu)
1708 (menu-bar-update-yank-menu string (and replace (car kill-ring))))
ab7e20d5 1709 (if (and replace kill-ring)
f914dc91
KH
1710 (setcar kill-ring string)
1711 (setq kill-ring (cons string kill-ring))
1712 (if (> (length kill-ring) kill-ring-max)
1713 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
70e14c01
JB
1714 (setq kill-ring-yank-pointer kill-ring)
1715 (if interprogram-cut-function
657a33ab 1716 (funcall interprogram-cut-function string (not replace))))
70e14c01 1717
2076c87c 1718(defun kill-append (string before-p)
70e14c01
JB
1719 "Append STRING to the end of the latest kill in the kill ring.
1720If BEFORE-P is non-nil, prepend STRING to the kill.
88c1aa79 1721If `interprogram-cut-function' is set, pass the resulting kill to
70e14c01 1722it."
f914dc91
KH
1723 (kill-new (if before-p
1724 (concat string (car kill-ring))
1725 (concat (car kill-ring) string)) t))
70e14c01
JB
1726
1727(defun current-kill (n &optional do-not-move)
1728 "Rotate the yanking point by N places, and then return that kill.
1729If N is zero, `interprogram-paste-function' is set, and calling it
1730returns a string, then that string is added to the front of the
1731kill ring and returned as the latest kill.
1e722f9f 1732If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
70e14c01
JB
1733yanking point; just return the Nth kill forward."
1734 (let ((interprogram-paste (and (= n 0)
1735 interprogram-paste-function
1736 (funcall interprogram-paste-function))))
1737 (if interprogram-paste
1738 (progn
1739 ;; Disable the interprogram cut function when we add the new
1740 ;; text to the kill ring, so Emacs doesn't try to own the
1741 ;; selection, with identical text.
1742 (let ((interprogram-cut-function nil))
1743 (kill-new interprogram-paste))
1744 interprogram-paste)
1745 (or kill-ring (error "Kill ring is empty"))
47096a67
PE
1746 (let ((ARGth-kill-element
1747 (nthcdr (mod (- n (length kill-ring-yank-pointer))
1748 (length kill-ring))
1749 kill-ring)))
70e14c01
JB
1750 (or do-not-move
1751 (setq kill-ring-yank-pointer ARGth-kill-element))
1752 (car ARGth-kill-element)))))
c88ab9ce 1753
c88ab9ce 1754
eaae8106 1755
70e14c01 1756;;;; Commands for manipulating the kill ring.
c88ab9ce 1757
69c1dd37
RS
1758(defcustom kill-read-only-ok nil
1759 "*Non-nil means don't signal an error for killing read-only text."
1760 :type 'boolean
1761 :group 'killing)
e6291fe1 1762
3a5da8a8
RS
1763(put 'text-read-only 'error-conditions
1764 '(text-read-only buffer-read-only error))
1765(put 'text-read-only 'error-message "Text is read-only")
1766
2076c87c
JB
1767(defun kill-region (beg end)
1768 "Kill between point and mark.
1769The text is deleted but saved in the kill ring.
1770The command \\[yank] can retrieve it from there.
81558867
EZ
1771\(If you want to kill and then yank immediately, use \\[kill-ring-save].)
1772
1773If you want to append the killed region to the last killed text,
1774use \\[append-next-kill] before \\[kill-region].
1775
2aa7a8bf
JB
1776If the buffer is read-only, Emacs will beep and refrain from deleting
1777the text, but put the text in the kill ring anyway. This means that
1778you can use the killing commands to copy text from a read-only buffer.
2076c87c
JB
1779
1780This is the primitive for programs to kill text (as opposed to deleting it).
1781Supply two arguments, character numbers indicating the stretch of text
1782 to be killed.
1783Any command that calls this function is a \"kill command\".
1784If the previous command was also a kill command,
1785the text killed this time appends to the text killed last time
1786to make one entry in the kill ring."
e761e42c 1787 (interactive "r")
ccd19b9f 1788 (condition-case nil
a1eb02bd
SM
1789 (let ((string (delete-and-extract-region beg end)))
1790 (when string ;STRING is nil if BEG = END
1791 ;; Add that string to the kill ring, one way or another.
1792 (if (eq last-command 'kill-region)
1793 (kill-append string (< end beg))
1794 (kill-new string)))
ccd19b9f
KH
1795 (setq this-command 'kill-region))
1796 ((buffer-read-only text-read-only)
1797 ;; The code above failed because the buffer, or some of the characters
1798 ;; in the region, are read-only.
1799 ;; We should beep, in case the user just isn't aware of this.
1800 ;; However, there's no harm in putting
1801 ;; the region's text in the kill ring, anyway.
1802 (copy-region-as-kill beg end)
cb3e1b4c
RS
1803 ;; Set this-command now, so it will be set even if we get an error.
1804 (setq this-command 'kill-region)
1805 ;; This should barf, if appropriate, and give us the correct error.
ccd19b9f
KH
1806 (if kill-read-only-ok
1807 (message "Read only text copied to kill ring")
ccd19b9f
KH
1808 ;; Signal an error if the buffer is read-only.
1809 (barf-if-buffer-read-only)
1810 ;; If the buffer isn't read-only, the text is.
1811 (signal 'text-read-only (list (current-buffer)))))))
2076c87c 1812
a382890a
KH
1813;; copy-region-as-kill no longer sets this-command, because it's confusing
1814;; to get two copies of the text when the user accidentally types M-w and
1815;; then corrects it with the intended C-w.
2076c87c
JB
1816(defun copy-region-as-kill (beg end)
1817 "Save the region as if killed, but don't kill it.
0e264847 1818In Transient Mark mode, deactivate the mark.
46947372
JB
1819If `interprogram-cut-function' is non-nil, also save the text for a window
1820system cut and paste."
2076c87c
JB
1821 (interactive "r")
1822 (if (eq last-command 'kill-region)
1823 (kill-append (buffer-substring beg end) (< end beg))
70e14c01 1824 (kill-new (buffer-substring beg end)))
1e722f9f 1825 (if transient-mark-mode
5c7319b6 1826 (setq deactivate-mark t))
2076c87c
JB
1827 nil)
1828
1829(defun kill-ring-save (beg end)
0964e562 1830 "Save the region as if killed, but don't kill it.
0e264847 1831In Transient Mark mode, deactivate the mark.
0964e562 1832If `interprogram-cut-function' is non-nil, also save the text for a window
0e264847
RS
1833system cut and paste.
1834
81558867
EZ
1835If you want to append the killed line to the last killed text,
1836use \\[append-next-kill] before \\[kill-ring-save].
1837
0e264847
RS
1838This command is similar to `copy-region-as-kill', except that it gives
1839visual feedback indicating the extent of the region being copied."
2076c87c
JB
1840 (interactive "r")
1841 (copy-region-as-kill beg end)
3a801d0c 1842 (if (interactive-p)
66050f10
RS
1843 (let ((other-end (if (= (point) beg) end beg))
1844 (opoint (point))
1845 ;; Inhibit quitting so we can make a quit here
1846 ;; look like a C-g typed as a command.
1847 (inhibit-quit t))
1848 (if (pos-visible-in-window-p other-end (selected-window))
1849 (progn
1850 ;; Swap point and mark.
1851 (set-marker (mark-marker) (point) (current-buffer))
1852 (goto-char other-end)
1853 (sit-for 1)
1854 ;; Swap back.
1855 (set-marker (mark-marker) other-end (current-buffer))
1856 (goto-char opoint)
1857 ;; If user quit, deactivate the mark
1858 ;; as C-g would as a command.
e4e593ae 1859 (and quit-flag mark-active
fcadf1c7 1860 (deactivate-mark)))
66050f10
RS
1861 (let* ((killed-text (current-kill 0))
1862 (message-len (min (length killed-text) 40)))
1863 (if (= (point) beg)
1864 ;; Don't say "killed"; that is misleading.
1865 (message "Saved text until \"%s\""
1866 (substring killed-text (- message-len)))
1867 (message "Saved text from \"%s\""
1868 (substring killed-text 0 message-len))))))))
2076c87c 1869
c75d4986
KH
1870(defun append-next-kill (&optional interactive)
1871 "Cause following command, if it kills, to append to previous kill.
1872The argument is used for internal purposes; do not supply one."
1873 (interactive "p")
1874 ;; We don't use (interactive-p), since that breaks kbd macros.
1875 (if interactive
2076c87c
JB
1876 (progn
1877 (setq this-command 'kill-region)
1878 (message "If the next command is a kill, it will append"))
1879 (setq last-command 'kill-region)))
eaae8106 1880
93be67de 1881;; Yanking.
2076c87c 1882
2076c87c 1883(defun yank-pop (arg)
ff1fbe3e
RS
1884 "Replace just-yanked stretch of killed text with a different stretch.
1885This command is allowed only immediately after a `yank' or a `yank-pop'.
2076c87c 1886At such a time, the region contains a stretch of reinserted
ff1fbe3e 1887previously-killed text. `yank-pop' deletes that text and inserts in its
2076c87c
JB
1888place a different stretch of killed text.
1889
1890With no argument, the previous kill is inserted.
ff1fbe3e
RS
1891With argument N, insert the Nth previous kill.
1892If N is negative, this is a more recent kill.
2076c87c
JB
1893
1894The sequence of kills wraps around, so that after the oldest one
1895comes the newest one."
1896 (interactive "*p")
1897 (if (not (eq last-command 'yank))
1898 (error "Previous command was not a yank"))
1899 (setq this-command 'yank)
3a5da8a8
RS
1900 (let ((inhibit-read-only t)
1901 (before (< (point) (mark t))))
9a1277dd 1902 (delete-region (point) (mark t))
fd0f4056 1903 (set-marker (mark-marker) (point) (current-buffer))
6cd829a8 1904 (let ((opoint (point)))
7ae13091 1905 (insert (current-kill arg))
6cd829a8
RS
1906 (let ((inhibit-read-only t))
1907 (remove-text-properties opoint (point) '(read-only nil))))
fd0f4056
RS
1908 (if before
1909 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
1910 ;; It is cleaner to avoid activation, even though the command
1911 ;; loop would deactivate the mark because we inserted text.
1912 (goto-char (prog1 (mark t)
1913 (set-marker (mark-marker) (point) (current-buffer))))))
0964e562 1914 nil)
2076c87c
JB
1915
1916(defun yank (&optional arg)
1917 "Reinsert the last stretch of killed text.
1918More precisely, reinsert the stretch of killed text most recently
ff1fbe3e
RS
1919killed OR yanked. Put point at end, and set mark at beginning.
1920With just C-u as argument, same but put point at beginning (and mark at end).
1921With argument N, reinsert the Nth most recently killed stretch of killed
2076c87c
JB
1922text.
1923See also the command \\[yank-pop]."
1924 (interactive "*P")
456c617c
RS
1925 ;; If we don't get all the way thru, make last-command indicate that
1926 ;; for the following command.
1927 (setq this-command t)
2076c87c 1928 (push-mark (point))
6cd829a8 1929 (let ((opoint (point)))
7ae13091
RS
1930 (insert (current-kill (cond
1931 ((listp arg) 0)
1932 ((eq arg '-) -1)
1933 (t (1- arg)))))
6cd829a8
RS
1934 (let ((inhibit-read-only t))
1935 (remove-text-properties opoint (point) '(read-only nil))))
2076c87c 1936 (if (consp arg)
fd0f4056
RS
1937 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
1938 ;; It is cleaner to avoid activation, even though the command
1939 ;; loop would deactivate the mark because we inserted text.
1940 (goto-char (prog1 (mark t)
1941 (set-marker (mark-marker) (point) (current-buffer)))))
456c617c
RS
1942 ;; If we do get all the way thru, make this-command indicate that.
1943 (setq this-command 'yank)
0964e562 1944 nil)
70e14c01
JB
1945
1946(defun rotate-yank-pointer (arg)
1947 "Rotate the yanking point in the kill ring.
1948With argument, rotate that many kills forward (or backward, if negative)."
1949 (interactive "p")
1950 (current-kill arg))
eaae8106 1951
93be67de
KH
1952;; Some kill commands.
1953
1954;; Internal subroutine of delete-char
1955(defun kill-forward-chars (arg)
1956 (if (listp arg) (setq arg (car arg)))
1957 (if (eq arg '-) (setq arg -1))
1958 (kill-region (point) (forward-point arg)))
1959
1960;; Internal subroutine of backward-delete-char
1961(defun kill-backward-chars (arg)
1962 (if (listp arg) (setq arg (car arg)))
1963 (if (eq arg '-) (setq arg -1))
1964 (kill-region (point) (forward-point (- arg))))
1965
1966(defcustom backward-delete-char-untabify-method 'untabify
1967 "*The method for untabifying when deleting backward.
1e722f9f
SS
1968Can be `untabify' -- turn a tab to many spaces, then delete one space;
1969 `hungry' -- delete all whitespace, both tabs and spaces;
1970 `all' -- delete all whitespace, including tabs, spaces and newlines;
93be67de 1971 nil -- just delete one character."
1e722f9f 1972 :type '(choice (const untabify) (const hungry) (const all) (const nil))
03167a34 1973 :version "20.3"
93be67de
KH
1974 :group 'killing)
1975
1976(defun backward-delete-char-untabify (arg &optional killp)
1977 "Delete characters backward, changing tabs into spaces.
1978The exact behavior depends on `backward-delete-char-untabify-method'.
1979Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
1980Interactively, ARG is the prefix arg (default 1)
1981and KILLP is t if a prefix arg was specified."
1982 (interactive "*p\nP")
1983 (when (eq backward-delete-char-untabify-method 'untabify)
1984 (let ((count arg))
1985 (save-excursion
1986 (while (and (> count 0) (not (bobp)))
1987 (if (= (preceding-char) ?\t)
1988 (let ((col (current-column)))
1989 (forward-char -1)
1990 (setq col (- col (current-column)))
1991 (insert-char ?\ col)
1992 (delete-char 1)))
1993 (forward-char -1)
1994 (setq count (1- count))))))
1995 (delete-backward-char
1e722f9f
SS
1996 (let ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t")
1997 ((eq backward-delete-char-untabify-method 'all)
1998 " \t\n\r"))))
1999 (if skip
2000 (let ((wh (- (point) (save-excursion (skip-chars-backward skip)
93be67de
KH
2001 (point)))))
2002 (+ arg (if (zerop wh) 0 (1- wh))))
1e722f9f 2003 arg))
93be67de
KH
2004 killp))
2005
2006(defun zap-to-char (arg char)
2007 "Kill up to and including ARG'th occurrence of CHAR.
2008Case is ignored if `case-fold-search' is non-nil in the current buffer.
2009Goes backward if ARG is negative; error if CHAR not found."
e761e42c 2010 (interactive "p\ncZap to char: ")
93be67de
KH
2011 (kill-region (point) (progn
2012 (search-forward (char-to-string char) nil nil arg)
2013; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
2014 (point))))
eaae8106 2015
93be67de
KH
2016;; kill-line and its subroutines.
2017
2018(defcustom kill-whole-line nil
2019 "*If non-nil, `kill-line' with no arg at beg of line kills the whole line."
2020 :type 'boolean
2021 :group 'killing)
2022
2023(defun kill-line (&optional arg)
2024 "Kill the rest of the current line; if no nonblanks there, kill thru newline.
2025With prefix argument, kill that many lines from point.
2026Negative arguments kill lines backward.
8be7408c 2027With zero argument, kills the text before point on the current line.
93be67de
KH
2028
2029When calling from a program, nil means \"no arg\",
2030a number counts as a prefix arg.
2031
2032To kill a whole line, when point is not at the beginning, type \
2033\\[beginning-of-line] \\[kill-line] \\[kill-line].
2034
2035If `kill-whole-line' is non-nil, then this command kills the whole line
2036including its terminating newline, when used at the beginning of a line
2037with no argument. As a consequence, you can always kill a whole line
d3f22784
EZ
2038by typing \\[beginning-of-line] \\[kill-line].
2039
81558867
EZ
2040If you want to append the killed line to the last killed text,
2041use \\[append-next-kill] before \\[kill-line].
2042
d3f22784
EZ
2043If the buffer is read-only, Emacs will beep and refrain from deleting
2044the line, but put the line in the kill ring anyway. This means that
2045you can use this command to copy text from a read-only buffer."
e761e42c 2046 (interactive "P")
93be67de
KH
2047 (kill-region (point)
2048 ;; It is better to move point to the other end of the kill
2049 ;; before killing. That way, in a read-only buffer, point
2050 ;; moves across the text that is copied to the kill ring.
2051 ;; The choice has no effect on undo now that undo records
2052 ;; the value of point from before the command was run.
2053 (progn
2054 (if arg
2055 (forward-visible-line (prefix-numeric-value arg))
2056 (if (eobp)
2057 (signal 'end-of-buffer nil))
2058 (if (or (looking-at "[ \t]*$") (and kill-whole-line (bolp)))
2059 (forward-visible-line 1)
2060 (end-of-visible-line)))
2061 (point))))
2062
2063(defun forward-visible-line (arg)
2064 "Move forward by ARG lines, ignoring currently invisible newlines only.
2065If ARG is negative, move backward -ARG lines.
2066If ARG is zero, move to the beginning of the current line."
2067 (condition-case nil
2068 (if (> arg 0)
2069 (while (> arg 0)
2070 (or (zerop (forward-line 1))
2071 (signal 'end-of-buffer nil))
2072 ;; If the following character is currently invisible,
2073 ;; skip all characters with that same `invisible' property value,
2074 ;; then find the next newline.
2075 (while (and (not (eobp))
2076 (let ((prop
2077 (get-char-property (point) 'invisible)))
2078 (if (eq buffer-invisibility-spec t)
2079 prop
2080 (or (memq prop buffer-invisibility-spec)
2081 (assq prop buffer-invisibility-spec)))))
2082 (goto-char
2083 (if (get-text-property (point) 'invisible)
2084 (or (next-single-property-change (point) 'invisible)
2085 (point-max))
2086 (next-overlay-change (point))))
2087 (or (zerop (forward-line 1))
2088 (signal 'end-of-buffer nil)))
2089 (setq arg (1- arg)))
2090 (let ((first t))
2091 (while (or first (< arg 0))
2092 (if (zerop arg)
2093 (beginning-of-line)
2094 (or (zerop (forward-line -1))
2095 (signal 'beginning-of-buffer nil)))
2096 (while (and (not (bobp))
2097 (let ((prop
2098 (get-char-property (1- (point)) 'invisible)))
2099 (if (eq buffer-invisibility-spec t)
2100 prop
2101 (or (memq prop buffer-invisibility-spec)
2102 (assq prop buffer-invisibility-spec)))))
2103 (goto-char
2104 (if (get-text-property (1- (point)) 'invisible)
2105 (or (previous-single-property-change (point) 'invisible)
2106 (point-min))
2107 (previous-overlay-change (point))))
2108 (or (zerop (forward-line -1))
2109 (signal 'beginning-of-buffer nil)))
2110 (setq first nil)
2111 (setq arg (1+ arg)))))
2112 ((beginning-of-buffer end-of-buffer)
2113 nil)))
70e14c01 2114
93be67de
KH
2115(defun end-of-visible-line ()
2116 "Move to end of current visible line."
2117 (end-of-line)
2118 ;; If the following character is currently invisible,
2119 ;; skip all characters with that same `invisible' property value,
2120 ;; then find the next newline.
2121 (while (and (not (eobp))
2122 (let ((prop
2123 (get-char-property (point) 'invisible)))
2124 (if (eq buffer-invisibility-spec t)
2125 prop
2126 (or (memq prop buffer-invisibility-spec)
2127 (assq prop buffer-invisibility-spec)))))
2128 (if (get-text-property (point) 'invisible)
2129 (goto-char (next-single-property-change (point) 'invisible))
2130 (goto-char (next-overlay-change (point))))
2131 (end-of-line)))
eaae8106 2132
2076c87c
JB
2133(defun insert-buffer (buffer)
2134 "Insert after point the contents of BUFFER.
2135Puts mark after the inserted text.
6cb6e7a2
GM
2136BUFFER may be a buffer or a buffer name.
2137
2138This function is meant for the user to run interactively.
2139Don't call it from programs!"
c3d4f949 2140 (interactive
a3e7c391
FP
2141 (list
2142 (progn
2143 (barf-if-buffer-read-only)
2144 (read-buffer "Insert buffer: "
2145 (if (eq (selected-window) (next-window (selected-window)))
2146 (other-buffer (current-buffer))
2147 (window-buffer (next-window (selected-window))))
2148 t))))
2076c87c
JB
2149 (or (bufferp buffer)
2150 (setq buffer (get-buffer buffer)))
2151 (let (start end newmark)
2152 (save-excursion
2153 (save-excursion
2154 (set-buffer buffer)
2155 (setq start (point-min) end (point-max)))
2156 (insert-buffer-substring buffer start end)
2157 (setq newmark (point)))
1537a263
JB
2158 (push-mark newmark))
2159 nil)
2076c87c
JB
2160
2161(defun append-to-buffer (buffer start end)
2162 "Append to specified buffer the text of the region.
2163It is inserted into that buffer before its point.
2164
2165When calling from a program, give three arguments:
2166BUFFER (or buffer name), START and END.
2167START and END specify the portion of the current buffer to be copied."
70e14c01 2168 (interactive
5d771766 2169 (list (read-buffer "Append to buffer: " (other-buffer (current-buffer) t))
23efee2c 2170 (region-beginning) (region-end)))
2076c87c
JB
2171 (let ((oldbuf (current-buffer)))
2172 (save-excursion
c069a480
GM
2173 (let* ((append-to (get-buffer-create buffer))
2174 (windows (get-buffer-window-list append-to t t))
2175 point)
2176 (set-buffer append-to)
2177 (setq point (point))
2178 (barf-if-buffer-read-only)
2179 (insert-buffer-substring oldbuf start end)
2180 (dolist (window windows)
2181 (when (= (window-point window) point)
2182 (set-window-point window (point))))))))
2076c87c
JB
2183
2184(defun prepend-to-buffer (buffer start end)
2185 "Prepend to specified buffer the text of the region.
2186It is inserted into that buffer after its point.
2187
2188When calling from a program, give three arguments:
2189BUFFER (or buffer name), START and END.
2190START and END specify the portion of the current buffer to be copied."
2191 (interactive "BPrepend to buffer: \nr")
2192 (let ((oldbuf (current-buffer)))
2193 (save-excursion
2194 (set-buffer (get-buffer-create buffer))
74399eac 2195 (barf-if-buffer-read-only)
2076c87c
JB
2196 (save-excursion
2197 (insert-buffer-substring oldbuf start end)))))
2198
2199(defun copy-to-buffer (buffer start end)
2200 "Copy to specified buffer the text of the region.
2201It is inserted into that buffer, replacing existing text there.
2202
2203When calling from a program, give three arguments:
2204BUFFER (or buffer name), START and END.
2205START and END specify the portion of the current buffer to be copied."
2206 (interactive "BCopy to buffer: \nr")
2207 (let ((oldbuf (current-buffer)))
2208 (save-excursion
2209 (set-buffer (get-buffer-create buffer))
74399eac 2210 (barf-if-buffer-read-only)
2076c87c
JB
2211 (erase-buffer)
2212 (save-excursion
2213 (insert-buffer-substring oldbuf start end)))))
eaae8106 2214
62d1c1fc
RM
2215(put 'mark-inactive 'error-conditions '(mark-inactive error))
2216(put 'mark-inactive 'error-message "The mark is not active now")
2217
af39530e 2218(defun mark (&optional force)
c7c8b31e 2219 "Return this buffer's mark value as integer; error if mark inactive.
af39530e 2220If optional argument FORCE is non-nil, access the mark value
c7c8b31e
RS
2221even if the mark is not currently active, and return nil
2222if there is no mark at all.
af39530e 2223
2076c87c
JB
2224If you are using this in an editing command, you are most likely making
2225a mistake; see the documentation of `set-mark'."
0e3a7b14 2226 (if (or force (not transient-mark-mode) mark-active mark-even-if-inactive)
af39530e 2227 (marker-position (mark-marker))
62d1c1fc 2228 (signal 'mark-inactive nil)))
2076c87c 2229
19d35374
RM
2230;; Many places set mark-active directly, and several of them failed to also
2231;; run deactivate-mark-hook. This shorthand should simplify.
2232(defsubst deactivate-mark ()
2233 "Deactivate the mark by setting `mark-active' to nil.
fcadf1c7 2234\(That makes a difference only in Transient Mark mode.)
19d35374 2235Also runs the hook `deactivate-mark-hook'."
a4b9d3da
RS
2236 (if transient-mark-mode
2237 (progn
2238 (setq mark-active nil)
2239 (run-hooks 'deactivate-mark-hook))))
19d35374 2240
2076c87c
JB
2241(defun set-mark (pos)
2242 "Set this buffer's mark to POS. Don't use this function!
2243That is to say, don't use this function unless you want
2244the user to see that the mark has moved, and you want the previous
2245mark position to be lost.
2246
2247Normally, when a new mark is set, the old one should go on the stack.
2248This is why most applications should use push-mark, not set-mark.
2249
ff1fbe3e 2250Novice Emacs Lisp programmers often try to use the mark for the wrong
2076c87c
JB
2251purposes. The mark saves a location for the user's convenience.
2252Most editing commands should not alter the mark.
2253To remember a location for internal use in the Lisp program,
2254store it in a Lisp variable. Example:
2255
2256 (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
2257
fcadf1c7
RS
2258 (if pos
2259 (progn
2260 (setq mark-active t)
2261 (run-hooks 'activate-mark-hook)
2262 (set-marker (mark-marker) pos (current-buffer)))
24c22852
RS
2263 ;; Normally we never clear mark-active except in Transient Mark mode.
2264 ;; But when we actually clear out the mark value too,
2265 ;; we must clear mark-active in any mode.
2266 (setq mark-active nil)
2267 (run-hooks 'deactivate-mark-hook)
2268 (set-marker (mark-marker) nil)))
2076c87c
JB
2269
2270(defvar mark-ring nil
e55e2267 2271 "The list of former marks of the current buffer, most recent first.")
2076c87c 2272(make-variable-buffer-local 'mark-ring)
e55e2267 2273(put 'mark-ring 'permanent-local t)
2076c87c 2274
69c1dd37
RS
2275(defcustom mark-ring-max 16
2276 "*Maximum size of mark ring. Start discarding off end if gets this big."
2277 :type 'integer
2278 :group 'editing-basics)
2076c87c 2279
dc029f0b
RM
2280(defvar global-mark-ring nil
2281 "The list of saved global marks, most recent first.")
2282
69c1dd37 2283(defcustom global-mark-ring-max 16
dc029f0b 2284 "*Maximum size of global mark ring. \
69c1dd37
RS
2285Start discarding off end if gets this big."
2286 :type 'integer
2287 :group 'editing-basics)
dc029f0b 2288
2076c87c
JB
2289(defun set-mark-command (arg)
2290 "Set mark at where point is, or jump to mark.
dc029f0b
RM
2291With no prefix argument, set mark, push old mark position on local mark
2292ring, and push mark on global mark ring.
2293With argument, jump to mark, and pop a new position for mark off the ring
2294\(does not affect global mark ring\).
2076c87c 2295
ff1fbe3e 2296Novice Emacs Lisp programmers often try to use the mark for the wrong
2076c87c
JB
2297purposes. See the documentation of `set-mark' for more information."
2298 (interactive "P")
2299 (if (null arg)
9a1277dd 2300 (progn
fd0f4056 2301 (push-mark nil nil t))
af39530e 2302 (if (null (mark t))
2076c87c 2303 (error "No mark set in this buffer")
9a1277dd 2304 (goto-char (mark t))
2076c87c
JB
2305 (pop-mark))))
2306
fd0f4056 2307(defun push-mark (&optional location nomsg activate)
2076c87c 2308 "Set mark at LOCATION (point, by default) and push old mark on mark ring.
f1382a3d
RM
2309If the last global mark pushed was not in the current buffer,
2310also push LOCATION on the global mark ring.
fd0f4056 2311Display `Mark set' unless the optional second arg NOMSG is non-nil.
8cdc660f 2312In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil.
2076c87c 2313
ff1fbe3e 2314Novice Emacs Lisp programmers often try to use the mark for the wrong
9a1277dd
RS
2315purposes. See the documentation of `set-mark' for more information.
2316
2317In Transient Mark mode, this does not activate the mark."
af39530e 2318 (if (null (mark t))
2076c87c
JB
2319 nil
2320 (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
2321 (if (> (length mark-ring) mark-ring-max)
2322 (progn
2323 (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
2324 (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
9a1277dd 2325 (set-marker (mark-marker) (or location (point)) (current-buffer))
dc029f0b 2326 ;; Now push the mark on the global mark ring.
f1382a3d 2327 (if (and global-mark-ring
e08d3f7c 2328 (eq (marker-buffer (car global-mark-ring)) (current-buffer)))
f1382a3d
RM
2329 ;; The last global mark pushed was in this same buffer.
2330 ;; Don't push another one.
2331 nil
2332 (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring))
dc029f0b
RM
2333 (if (> (length global-mark-ring) global-mark-ring-max)
2334 (progn
2335 (move-marker (car (nthcdr global-mark-ring-max global-mark-ring))
2336 nil)
f1382a3d 2337 (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))
efcf38c7 2338 (or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
2076c87c 2339 (message "Mark set"))
8cdc660f
RS
2340 (if (or activate (not transient-mark-mode))
2341 (set-mark (mark t)))
2076c87c
JB
2342 nil)
2343
2344(defun pop-mark ()
2345 "Pop off mark ring into the buffer's actual mark.
2346Does not set point. Does nothing if mark ring is empty."
2347 (if mark-ring
2348 (progn
2349 (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
9a1277dd 2350 (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
19d35374 2351 (deactivate-mark)
2076c87c 2352 (move-marker (car mark-ring) nil)
9a1277dd 2353 (if (null (mark t)) (ding))
2076c87c
JB
2354 (setq mark-ring (cdr mark-ring)))))
2355
e462e42f 2356(defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
2076c87c 2357(defun exchange-point-and-mark ()
af39530e
RS
2358 "Put the mark where point is now, and point where the mark is now.
2359This command works even when the mark is not active,
2360and it reactivates the mark."
2076c87c 2361 (interactive nil)
af39530e 2362 (let ((omark (mark t)))
2076c87c
JB
2363 (if (null omark)
2364 (error "No mark set in this buffer"))
2365 (set-mark (point))
2366 (goto-char omark)
2367 nil))
e23c2c21 2368
22c3935a 2369(defun transient-mark-mode (arg)
e23c2c21 2370 "Toggle Transient Mark mode.
b411b5fa 2371With arg, turn Transient Mark mode on if arg is positive, off otherwise.
e23c2c21 2372
5dd1220d
RS
2373In Transient Mark mode, when the mark is active, the region is highlighted.
2374Changing the buffer \"deactivates\" the mark.
2375So do certain other operations that set the mark
2376but whose main purpose is something else--for example,
cfa70244
EZ
2377incremental search, \\[beginning-of-buffer], and \\[end-of-buffer].
2378
8e843bc4
EZ
2379You can also deactivate the mark by typing \\[keyboard-quit] or
2380\\[keyboard-escape-quit].
1465c66b 2381
cfa70244
EZ
2382Many commands change their behavior when Transient Mark mode is in effect
2383and the mark is active, by acting on the region instead of their usual
4c5f7215 2384default part of the buffer's text. Examples of such commands include
cfa70244
EZ
2385\\[comment-dwim], \\[flush-lines], \\[ispell], \\[keep-lines],
2386\\[query-replace], \\[query-replace-regexp], and \\[undo]. Invoke
c4e39bdd
EZ
2387\\[apropos-documentation] and type \"transient\" or \"mark.*active\" at
2388the prompt, to see the documentation of commands which are sensitive to
2389the Transient Mark mode."
22c3935a 2390 (interactive "P")
e23c2c21
RS
2391 (setq transient-mark-mode
2392 (if (null arg)
2393 (not transient-mark-mode)
2c5d387c 2394 (> (prefix-numeric-value arg) 0)))
22c3935a
RS
2395 (if (interactive-p)
2396 (if transient-mark-mode
2397 (message "Transient Mark mode enabled")
2398 (message "Transient Mark mode disabled"))))
dc029f0b
RM
2399
2400(defun pop-global-mark ()
2401 "Pop off global mark ring and jump to the top location."
2402 (interactive)
52b6d445
RS
2403 ;; Pop entries which refer to non-existent buffers.
2404 (while (and global-mark-ring (not (marker-buffer (car global-mark-ring))))
2405 (setq global-mark-ring (cdr global-mark-ring)))
dc029f0b
RM
2406 (or global-mark-ring
2407 (error "No global mark set"))
2408 (let* ((marker (car global-mark-ring))
2409 (buffer (marker-buffer marker))
2410 (position (marker-position marker)))
34c31301
RS
2411 (setq global-mark-ring (nconc (cdr global-mark-ring)
2412 (list (car global-mark-ring))))
dc029f0b
RM
2413 (set-buffer buffer)
2414 (or (and (>= position (point-min))
2415 (<= position (point-max)))
2416 (widen))
2417 (goto-char position)
2418 (switch-to-buffer buffer)))
eaae8106 2419
95791033 2420(defcustom next-line-add-newlines nil
69c1dd37
RS
2421 "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error."
2422 :type 'boolean
e1d6e383 2423 :version "21.1"
69c1dd37 2424 :group 'editing-basics)
38ebcf29 2425
2076c87c
JB
2426(defun next-line (arg)
2427 "Move cursor vertically down ARG lines.
2428If there is no character in the target line exactly under the current column,
2429the cursor is positioned after the character in that line which spans this
2430column, or at the end of the line if it is not long enough.
38ebcf29 2431If there is no line in the buffer after this one, behavior depends on the
1a2c3941
RS
2432value of `next-line-add-newlines'. If non-nil, it inserts a newline character
2433to create a line, and moves the cursor to that line. Otherwise it moves the
e47d38f6 2434cursor to the end of the buffer.
2076c87c
JB
2435
2436The command \\[set-goal-column] can be used to create
85969cb1
RS
2437a semipermanent goal column for this command.
2438Then instead of trying to move exactly vertically (or as close as possible),
2439this command moves to the specified goal column (or as close as possible).
2440The goal column is stored in the variable `goal-column', which is nil
2441when there is no goal column.
2076c87c
JB
2442
2443If you are thinking of using this in a Lisp program, consider
2444using `forward-line' instead. It is usually easier to use
2445and more reliable (no dependence on goal column, etc.)."
2446 (interactive "p")
028922cf 2447 (if (and next-line-add-newlines (= arg 1))
207d7545
GM
2448 (if (save-excursion (end-of-line) (eobp))
2449 ;; When adding a newline, don't expand an abbrev.
2450 (let ((abbrev-mode nil))
24886813
GM
2451 (end-of-line)
2452 (insert "\n"))
207d7545 2453 (line-move arg))
1a2c3941
RS
2454 (if (interactive-p)
2455 (condition-case nil
2456 (line-move arg)
2457 ((beginning-of-buffer end-of-buffer) (ding)))
2458 (line-move arg)))
2076c87c
JB
2459 nil)
2460
2461(defun previous-line (arg)
2462 "Move cursor vertically up ARG lines.
2463If there is no character in the target line exactly over the current column,
2464the cursor is positioned after the character in that line which spans this
2465column, or at the end of the line if it is not long enough.
2466
2467The command \\[set-goal-column] can be used to create
85969cb1
RS
2468a semipermanent goal column for this command.
2469Then instead of trying to move exactly vertically (or as close as possible),
2470this command moves to the specified goal column (or as close as possible).
2471The goal column is stored in the variable `goal-column', which is nil
2472when there is no goal column.
2076c87c
JB
2473
2474If you are thinking of using this in a Lisp program, consider using
c2e8a012 2475`forward-line' with a negative argument instead. It is usually easier
2076c87c
JB
2476to use and more reliable (no dependence on goal column, etc.)."
2477 (interactive "p")
1a2c3941
RS
2478 (if (interactive-p)
2479 (condition-case nil
2480 (line-move (- arg))
2481 ((beginning-of-buffer end-of-buffer) (ding)))
2482 (line-move (- arg)))
2076c87c 2483 nil)
eaae8106 2484
69c1dd37 2485(defcustom track-eol nil
2076c87c
JB
2486 "*Non-nil means vertical motion starting at end of line keeps to ends of lines.
2487This means moving to the end of each line moved onto.
69c1dd37
RS
2488The beginning of a blank line does not count as the end of a line."
2489 :type 'boolean
2490 :group 'editing-basics)
2491
2492(defcustom goal-column nil
2493 "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil."
2494 :type '(choice integer
2495 (const :tag "None" nil))
2496 :group 'editing-basics)
912c6728 2497(make-variable-buffer-local 'goal-column)
2076c87c
JB
2498
2499(defvar temporary-goal-column 0
2500 "Current goal column for vertical motion.
2501It is the column where point was
2502at the start of current run of vertical motion commands.
c637ae6f 2503When the `track-eol' feature is doing its job, the value is 9999.")
2076c87c 2504
69c1dd37 2505(defcustom line-move-ignore-invisible nil
098fc1fb 2506 "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
69c1dd37
RS
2507Outline mode sets this."
2508 :type 'boolean
2509 :group 'editing-basics)
098fc1fb 2510
8c745744
RS
2511;; This is the guts of next-line and previous-line.
2512;; Arg says how many lines to move.
2076c87c 2513(defun line-move (arg)
2596511d
RS
2514 ;; Don't run any point-motion hooks, and disregard intangibility,
2515 ;; for intermediate positions.
2516 (let ((inhibit-point-motion-hooks t)
2517 (opoint (point))
6c8499b9 2518 new line-end line-beg)
2596511d
RS
2519 (unwind-protect
2520 (progn
2521 (if (not (or (eq last-command 'next-line)
2522 (eq last-command 'previous-line)))
2523 (setq temporary-goal-column
2524 (if (and track-eol (eolp)
2525 ;; Don't count beg of empty line as end of line
2526 ;; unless we just did explicit end-of-line.
2527 (or (not (bolp)) (eq last-command 'end-of-line)))
2528 9999
2529 (current-column))))
2530 (if (and (not (integerp selective-display))
2531 (not line-move-ignore-invisible))
2532 ;; Use just newline characters.
2533 (or (if (> arg 0)
2534 (progn (if (> arg 1) (forward-line (1- arg)))
2535 ;; This way of moving forward ARG lines
2536 ;; verifies that we have a newline after the last one.
2537 ;; It doesn't get confused by intangible text.
2538 (end-of-line)
2539 (zerop (forward-line 1)))
2540 (and (zerop (forward-line arg))
2541 (bolp)))
2542 (signal (if (< arg 0)
2543 'beginning-of-buffer
2544 'end-of-buffer)
2545 nil))
2546 ;; Move by arg lines, but ignore invisible ones.
2547 (while (> arg 0)
2548 (end-of-line)
2549 (and (zerop (vertical-motion 1))
2550 (signal 'end-of-buffer nil))
2551 ;; If the following character is currently invisible,
2552 ;; skip all characters with that same `invisible' property value.
2553 (while (and (not (eobp))
2554 (let ((prop
2555 (get-char-property (point) 'invisible)))
2556 (if (eq buffer-invisibility-spec t)
2557 prop
2558 (or (memq prop buffer-invisibility-spec)
2559 (assq prop buffer-invisibility-spec)))))
2560 (if (get-text-property (point) 'invisible)
2561 (goto-char (next-single-property-change (point) 'invisible))
2562 (goto-char (next-overlay-change (point)))))
2563 (setq arg (1- arg)))
2564 (while (< arg 0)
2565 (beginning-of-line)
2566 (and (zerop (vertical-motion -1))
2567 (signal 'beginning-of-buffer nil))
2568 (while (and (not (bobp))
2569 (let ((prop
2570 (get-char-property (1- (point)) 'invisible)))
2571 (if (eq buffer-invisibility-spec t)
2572 prop
2573 (or (memq prop buffer-invisibility-spec)
2574 (assq prop buffer-invisibility-spec)))))
2575 (if (get-text-property (1- (point)) 'invisible)
2576 (goto-char (previous-single-property-change (point) 'invisible))
2577 (goto-char (previous-overlay-change (point)))))
2578 (setq arg (1+ arg))))
0565d307
RS
2579 (let ((buffer-invisibility-spec nil))
2580 (move-to-column (or goal-column temporary-goal-column))))
50be475d
RS
2581 (setq new (point))
2582 ;; If we are moving into some intangible text,
2583 ;; look for following text on the same line which isn't intangible
2584 ;; and move there.
6c8499b9
RS
2585 (setq line-end (save-excursion (end-of-line) (point)))
2586 (setq line-beg (save-excursion (beginning-of-line) (point)))
50be475d
RS
2587 (let ((after (and (< new (point-max))
2588 (get-char-property new 'intangible)))
2589 (before (and (> new (point-min))
6c8499b9
RS
2590 (get-char-property (1- new) 'intangible))))
2591 (when (and before (eq before after)
2592 (not (bolp)))
50be475d
RS
2593 (goto-char (point-min))
2594 (let ((inhibit-point-motion-hooks nil))
2595 (goto-char new))
2596 (if (<= new line-end)
2597 (setq new (point)))))
6c8499b9
RS
2598 ;; NEW is where we want to move to.
2599 ;; LINE-BEG and LINE-END are the beginning and end of the line.
2600 ;; Move there in just one step, from our starting position,
2601 ;; with intangibility and point-motion hooks enabled this time.
2596511d
RS
2602 (goto-char opoint)
2603 (setq inhibit-point-motion-hooks nil)
1369261b 2604 (goto-char
50af0a5b 2605 (constrain-to-field new opoint nil t 'inhibit-line-move-field-capture))
6c8499b9
RS
2606 ;; If intangibility processing moved us to a different line,
2607 ;; readjust the horizontal position within the line we ended up at.
2608 (when (or (< (point) line-beg) (> (point) line-end))
2609 (setq new (point))
2610 (setq inhibit-point-motion-hooks t)
2611 (setq line-end (save-excursion (end-of-line) (point)))
2612 (beginning-of-line)
2613 (setq line-beg (point))
2614 (let ((buffer-invisibility-spec nil))
2615 (move-to-column (or goal-column temporary-goal-column)))
2616 (if (<= (point) line-end)
2617 (setq new (point)))
2618 (goto-char (point-min))
2619 (setq inhibit-point-motion-hooks nil)
1369261b 2620 (goto-char
50af0a5b
MB
2621 (constrain-to-field new opoint nil t
2622 'inhibit-line-move-field-capture)))))
2596511d 2623 nil)
2076c87c 2624
d5ab2033
JB
2625;;; Many people have said they rarely use this feature, and often type
2626;;; it by accident. Maybe it shouldn't even be on a key.
2627(put 'set-goal-column 'disabled t)
2076c87c
JB
2628
2629(defun set-goal-column (arg)
2630 "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
2631Those commands will move to this position in the line moved to
2632rather than trying to keep the same horizontal position.
2633With a non-nil argument, clears out the goal column
912c6728
RS
2634so that \\[next-line] and \\[previous-line] resume vertical motion.
2635The goal column is stored in the variable `goal-column'."
2076c87c
JB
2636 (interactive "P")
2637 (if arg
2638 (progn
2639 (setq goal-column nil)
2640 (message "No goal column"))
2641 (setq goal-column (current-column))
2642 (message (substitute-command-keys
2643 "Goal column %d (use \\[set-goal-column] with an arg to unset it)")
2644 goal-column))
2645 nil)
eaae8106 2646
7492f5a6
RS
2647
2648(defun scroll-other-window-down (lines)
e47d38f6
RS
2649 "Scroll the \"other window\" down.
2650For more details, see the documentation for `scroll-other-window'."
7492f5a6
RS
2651 (interactive "P")
2652 (scroll-other-window
2653 ;; Just invert the argument's meaning.
2654 ;; We can do that without knowing which window it will be.
2655 (if (eq lines '-) nil
2656 (if (null lines) '-
2657 (- (prefix-numeric-value lines))))))
e47d38f6 2658(define-key esc-map [?\C-\S-v] 'scroll-other-window-down)
3aef9604
RS
2659
2660(defun beginning-of-buffer-other-window (arg)
2661 "Move point to the beginning of the buffer in the other window.
2662Leave mark at previous position.
2663With arg N, put point N/10 of the way from the true beginning."
2664 (interactive "P")
2665 (let ((orig-window (selected-window))
2666 (window (other-window-for-scrolling)))
2667 ;; We use unwind-protect rather than save-window-excursion
2668 ;; because the latter would preserve the things we want to change.
2669 (unwind-protect
2670 (progn
2671 (select-window window)
2672 ;; Set point and mark in that window's buffer.
2673 (beginning-of-buffer arg)
2674 ;; Set point accordingly.
2675 (recenter '(t)))
2676 (select-window orig-window))))
2677
2678(defun end-of-buffer-other-window (arg)
2679 "Move point to the end of the buffer in the other window.
2680Leave mark at previous position.
2681With arg N, put point N/10 of the way from the true end."
2682 (interactive "P")
2683 ;; See beginning-of-buffer-other-window for comments.
2684 (let ((orig-window (selected-window))
2685 (window (other-window-for-scrolling)))
2686 (unwind-protect
2687 (progn
2688 (select-window window)
4500ff36 2689 (end-of-buffer arg)
3aef9604
RS
2690 (recenter '(t)))
2691 (select-window orig-window))))
eaae8106 2692
2076c87c
JB
2693(defun transpose-chars (arg)
2694 "Interchange characters around point, moving forward one character.
2695With prefix arg ARG, effect is to take character before point
2696and drag it forward past ARG other characters (backward if ARG negative).
2697If no argument and at end of line, the previous two chars are exchanged."
2698 (interactive "*P")
2699 (and (null arg) (eolp) (forward-char -1))
2700 (transpose-subr 'forward-char (prefix-numeric-value arg)))
2701
2702(defun transpose-words (arg)
2703 "Interchange words around point, leaving point at end of them.
2704With prefix arg ARG, effect is to take word before or around point
2705and drag it forward past ARG other words (backward if ARG negative).
2706If ARG is zero, the words around or after point and around or after mark
2707are interchanged."
2708 (interactive "*p")
2709 (transpose-subr 'forward-word arg))
2710
2711(defun transpose-sexps (arg)
2712 "Like \\[transpose-words] but applies to sexps.
2713Does not work on a sexp that point is in the middle of
2714if it is a list or string."
2715 (interactive "*p")
2716 (transpose-subr 'forward-sexp arg))
2717
2718(defun transpose-lines (arg)
2719 "Exchange current line and previous line, leaving point after both.
2720With argument ARG, takes previous line and moves it past ARG lines.
2721With argument 0, interchanges line point is in with line mark is in."
2722 (interactive "*p")
2723 (transpose-subr (function
2724 (lambda (arg)
d3f4ef3f 2725 (if (> arg 0)
2076c87c 2726 (progn
d3f4ef3f
AS
2727 ;; Move forward over ARG lines,
2728 ;; but create newlines if necessary.
2729 (setq arg (forward-line arg))
2730 (if (/= (preceding-char) ?\n)
2731 (setq arg (1+ arg)))
2732 (if (> arg 0)
2733 (newline arg)))
2076c87c
JB
2734 (forward-line arg))))
2735 arg))
2736
8b56e02d
RS
2737(defvar transpose-subr-start1)
2738(defvar transpose-subr-start2)
2739(defvar transpose-subr-end1)
2740(defvar transpose-subr-end2)
2741
2076c87c 2742(defun transpose-subr (mover arg)
8b56e02d
RS
2743 (let (transpose-subr-start1
2744 transpose-subr-end1
2745 transpose-subr-start2
2746 transpose-subr-end2)
2076c87c
JB
2747 (if (= arg 0)
2748 (progn
2749 (save-excursion
2750 (funcall mover 1)
8b56e02d 2751 (setq transpose-subr-end2 (point))
2076c87c 2752 (funcall mover -1)
8b56e02d 2753 (setq transpose-subr-start2 (point))
2076c87c
JB
2754 (goto-char (mark))
2755 (funcall mover 1)
8b56e02d 2756 (setq transpose-subr-end1 (point))
2076c87c 2757 (funcall mover -1)
8b56e02d 2758 (setq transpose-subr-start1 (point))
2076c87c 2759 (transpose-subr-1))
d3f4ef3f
AS
2760 (exchange-point-and-mark))
2761 (if (> arg 0)
2762 (progn
2763 (funcall mover -1)
8b56e02d 2764 (setq transpose-subr-start1 (point))
d3f4ef3f 2765 (funcall mover 1)
8b56e02d 2766 (setq transpose-subr-end1 (point))
d3f4ef3f 2767 (funcall mover arg)
8b56e02d 2768 (setq transpose-subr-end2 (point))
d3f4ef3f 2769 (funcall mover (- arg))
8b56e02d 2770 (setq transpose-subr-start2 (point))
d3f4ef3f 2771 (transpose-subr-1)
8b56e02d 2772 (goto-char transpose-subr-end2))
d3f4ef3f 2773 (funcall mover -1)
8b56e02d 2774 (setq transpose-subr-start2 (point))
d3f4ef3f 2775 (funcall mover 1)
8b56e02d 2776 (setq transpose-subr-end2 (point))
d3f4ef3f 2777 (funcall mover (1- arg))
8b56e02d 2778 (setq transpose-subr-start1 (point))
d3f4ef3f 2779 (funcall mover (- arg))
8b56e02d 2780 (setq transpose-subr-end1 (point))
d3f4ef3f 2781 (transpose-subr-1)))))
2076c87c
JB
2782
2783(defun transpose-subr-1 ()
8b56e02d
RS
2784 (if (> (min transpose-subr-end1 transpose-subr-end2)
2785 (max transpose-subr-start1 transpose-subr-start2))
2076c87c 2786 (error "Don't have two things to transpose"))
8b56e02d 2787 (let* ((word1 (buffer-substring transpose-subr-start1 transpose-subr-end1))
d5d99b80 2788 (len1 (length word1))
8b56e02d 2789 (word2 (buffer-substring transpose-subr-start2 transpose-subr-end2))
d5d99b80 2790 (len2 (length word2)))
8b56e02d
RS
2791 (delete-region transpose-subr-start2 transpose-subr-end2)
2792 (goto-char transpose-subr-start2)
2076c87c 2793 (insert word1)
8b56e02d
RS
2794 (goto-char (if (< transpose-subr-start1 transpose-subr-start2)
2795 transpose-subr-start1
2796 (+ transpose-subr-start1 (- len1 len2))))
d5d99b80 2797 (delete-region (point) (+ (point) len1))
2076c87c 2798 (insert word2)))
eaae8106 2799
2076c87c 2800(defun backward-word (arg)
b7e91b0c 2801 "Move backward until encountering the beginning of a word.
20ecc110 2802With argument, do this that many times."
9e50756b 2803 (interactive "p")
2076c87c
JB
2804 (forward-word (- arg)))
2805
2806(defun mark-word (arg)
2807 "Set mark arg words away from point."
2808 (interactive "p")
2809 (push-mark
2810 (save-excursion
2811 (forward-word arg)
fd0f4056
RS
2812 (point))
2813 nil t))
2076c87c
JB
2814
2815(defun kill-word (arg)
2816 "Kill characters forward until encountering the end of a word.
2817With argument, do this that many times."
e761e42c 2818 (interactive "p")
89ee2bf6 2819 (kill-region (point) (progn (forward-word arg) (point))))
2076c87c
JB
2820
2821(defun backward-kill-word (arg)
2822 "Kill characters backward until encountering the end of a word.
2823With argument, do this that many times."
e761e42c 2824 (interactive "p")
2076c87c 2825 (kill-word (- arg)))
d7c64071 2826
1e8c5ac4
RS
2827(defun current-word (&optional strict)
2828 "Return the word point is on (or a nearby word) as a string.
2829If optional arg STRICT is non-nil, return nil unless point is within
2830or adjacent to a word."
d7c64071
ER
2831 (save-excursion
2832 (let ((oldpoint (point)) (start (point)) (end (point)))
2833 (skip-syntax-backward "w_") (setq start (point))
2834 (goto-char oldpoint)
2835 (skip-syntax-forward "w_") (setq end (point))
2836 (if (and (eq start oldpoint) (eq end oldpoint))
1e8c5ac4
RS
2837 ;; Point is neither within nor adjacent to a word.
2838 (and (not strict)
2839 (progn
2840 ;; Look for preceding word in same line.
2841 (skip-syntax-backward "^w_"
2842 (save-excursion (beginning-of-line)
2843 (point)))
2844 (if (bolp)
2845 ;; No preceding word in same line.
2846 ;; Look for following word in same line.
2847 (progn
2848 (skip-syntax-forward "^w_"
2849 (save-excursion (end-of-line)
2850 (point)))
2851 (setq start (point))
2852 (skip-syntax-forward "w_")
2853 (setq end (point)))
2854 (setq end (point))
2855 (skip-syntax-backward "w_")
2856 (setq start (point)))
020db25f
RS
2857 (buffer-substring-no-properties start end)))
2858 (buffer-substring-no-properties start end)))))
eaae8106 2859
69c1dd37 2860(defcustom fill-prefix nil
2076c87c 2861 "*String for filling to insert at front of new line, or nil for none.
69c1dd37
RS
2862Setting this variable automatically makes it local to the current buffer."
2863 :type '(choice (const :tag "None" nil)
2864 string)
2865 :group 'fill)
2076c87c
JB
2866(make-variable-buffer-local 'fill-prefix)
2867
69c1dd37
RS
2868(defcustom auto-fill-inhibit-regexp nil
2869 "*Regexp to match lines which should not be auto-filled."
2870 :type '(choice (const :tag "None" nil)
2871 regexp)
2872 :group 'fill)
2076c87c 2873
58dd38f1 2874(defvar comment-line-break-function 'comment-indent-new-line
b3ac9fa9
RS
2875 "*Mode-specific function which line breaks and continues a comment.
2876
2877This function is only called during auto-filling of a comment section.
2878The function should take a single optional argument, which is a flag
2879indicating whether it should use soft newlines.
2880
2881Setting this variable automatically makes it local to the current buffer.")
2882
dbe524b6 2883;; This function is used as the auto-fill-function of a buffer
e2504204
KH
2884;; when Auto-Fill mode is enabled.
2885;; It returns t if it really did any work.
dbe524b6
RS
2886;; (Actually some major modes use a different auto-fill function,
2887;; but this one is the default one.)
2076c87c 2888(defun do-auto-fill ()
a0170800
RS
2889 (let (fc justify bol give-up
2890 (fill-prefix fill-prefix))
c18465c4 2891 (if (or (not (setq justify (current-justification)))
8f066a20
RS
2892 (null (setq fc (current-fill-column)))
2893 (and (eq justify 'left)
2894 (<= (current-column) fc))
1e722f9f 2895 (save-excursion (beginning-of-line)
eed5698b
RS
2896 (setq bol (point))
2897 (and auto-fill-inhibit-regexp
2898 (looking-at auto-fill-inhibit-regexp))))
2899 nil ;; Auto-filling not required
3db1e3b5
BG
2900 (if (memq justify '(full center right))
2901 (save-excursion (unjustify-current-line)))
a0170800
RS
2902
2903 ;; Choose a fill-prefix automatically.
2904 (if (and adaptive-fill-mode
2905 (or (null fill-prefix) (string= fill-prefix "")))
e4b62d7c
RS
2906 (let ((prefix
2907 (fill-context-prefix
2908 (save-excursion (backward-paragraph 1) (point))
50be475d 2909 (save-excursion (forward-paragraph 1) (point)))))
e4b62d7c
RS
2910 (and prefix (not (equal prefix ""))
2911 (setq fill-prefix prefix))))
a0170800 2912
eed5698b 2913 (while (and (not give-up) (> (current-column) fc))
e47d38f6 2914 ;; Determine where to split the line.
db893d00
RS
2915 (let* (after-prefix
2916 (fill-point
2917 (let ((opoint (point))
2918 bounce
2919 (first t))
2920 (save-excursion
2921 (beginning-of-line)
2922 (setq after-prefix (point))
2923 (and fill-prefix
2924 (looking-at (regexp-quote fill-prefix))
2925 (setq after-prefix (match-end 0)))
2926 (move-to-column (1+ fc))
dbe524b6
RS
2927 ;; Move back to the point where we can break the line.
2928 ;; We break the line between word or
db893d00
RS
2929 ;; after/before the character which has character
2930 ;; category `|'. We search space, \c| followed by
dbe524b6 2931 ;; a character, or \c| following a character. If
db893d00
RS
2932 ;; not found, place the point at beginning of line.
2933 (while (or first
2934 ;; If this is after period and a single space,
2935 ;; move back once more--we don't want to break
2936 ;; the line there and make it look like a
2937 ;; sentence end.
2938 (and (not (bobp))
2939 (not bounce)
2940 sentence-end-double-space
2941 (save-excursion (forward-char -1)
2942 (and (looking-at "\\. ")
dbe524b6
RS
2943 (not (looking-at "\\. ")))))
2944 (and (not (bobp))
2945 (not bounce)
2946 fill-nobreak-predicate
2947 (funcall fill-nobreak-predicate)))
db893d00
RS
2948 (setq first nil)
2949 (re-search-backward "[ \t]\\|\\c|.\\|.\\c|\\|^")
2950 ;; If we find nowhere on the line to break it,
2951 ;; break after one word. Set bounce to t
2952 ;; so we will not keep going in this while loop.
2953 (if (<= (point) after-prefix)
2954 (progn
2955 (goto-char after-prefix)
2956 (re-search-forward "[ \t]" opoint t)
2957 (setq bounce t))
2958 (if (looking-at "[ \t]")
2959 ;; Break the line at word boundary.
2960 (skip-chars-backward " \t")
2961 ;; Break the line after/before \c|.
2962 (forward-char 1))))
22c47bc5 2963 (if enable-multibyte-characters
eb400532
KH
2964 ;; If we are going to break the line after or
2965 ;; before a non-ascii character, we may have
2966 ;; to run a special function for the charset
2967 ;; of the character to find the correct break
2968 ;; point.
2969 (if (not (and (eq (charset-after (1- (point))) 'ascii)
2970 (eq (charset-after (point)) 'ascii)))
2971 (fill-find-break-point after-prefix)))
2972
db893d00 2973 ;; Let fill-point be set to the place where we end up.
4b9c8a06
RS
2974 ;; But move back before any whitespace here.
2975 (skip-chars-backward " \t")
db893d00
RS
2976 (point)))))
2977
2978 ;; See whether the place we found is any good.
e47d38f6
RS
2979 (if (save-excursion
2980 (goto-char fill-point)
07f458c1 2981 (and (not (bolp))
db893d00
RS
2982 ;; There is no use breaking at end of line.
2983 (not (save-excursion (skip-chars-forward " ") (eolp)))
2984 ;; It is futile to split at the end of the prefix
2985 ;; since we would just insert the prefix again.
2986 (not (and after-prefix (<= (point) after-prefix)))
07f458c1
RS
2987 ;; Don't split right after a comment starter
2988 ;; since we would just make another comment starter.
2989 (not (and comment-start-skip
2990 (let ((limit (point)))
2991 (beginning-of-line)
2992 (and (re-search-forward comment-start-skip
2993 limit t)
2994 (eq (point) limit)))))))
db893d00 2995 ;; Ok, we have a useful place to break the line. Do it.
e47d38f6
RS
2996 (let ((prev-column (current-column)))
2997 ;; If point is at the fill-point, do not `save-excursion'.
2998 ;; Otherwise, if a comment prefix or fill-prefix is inserted,
2999 ;; point will end up before it rather than after it.
3000 (if (save-excursion
3001 (skip-chars-backward " \t")
3002 (= (point) fill-point))
b3ac9fa9 3003 (funcall comment-line-break-function t)
e47d38f6
RS
3004 (save-excursion
3005 (goto-char fill-point)
b3ac9fa9 3006 (funcall comment-line-break-function t)))
e47d38f6
RS
3007 ;; Now do justification, if required
3008 (if (not (eq justify 'left))
1e722f9f 3009 (save-excursion
e47d38f6
RS
3010 (end-of-line 0)
3011 (justify-current-line justify nil t)))
3012 ;; If making the new line didn't reduce the hpos of
3013 ;; the end of the line, then give up now;
3014 ;; trying again will not help.
3015 (if (>= (current-column) prev-column)
3016 (setq give-up t)))
db893d00 3017 ;; No good place to break => stop trying.
e47d38f6 3018 (setq give-up t))))
24ebf92e 3019 ;; Justify last line.
e2504204 3020 (justify-current-line justify t t)
1e722f9f 3021 t)))
2076c87c 3022
24ebf92e
RS
3023(defvar normal-auto-fill-function 'do-auto-fill
3024 "The function to use for `auto-fill-function' if Auto Fill mode is turned on.
3025Some major modes set this.")
3026
d7465b15 3027(defun auto-fill-mode (&optional arg)
24ebf92e
RS
3028 "Toggle Auto Fill mode.
3029With arg, turn Auto Fill mode on if and only if arg is positive.
3030In Auto Fill mode, inserting a space at a column beyond `current-fill-column'
3031automatically breaks the line at a previous space.
3032
3033The value of `normal-auto-fill-function' specifies the function to use
3034for `auto-fill-function' when turning Auto Fill mode on."
d7465b15
RS
3035 (interactive "P")
3036 (prog1 (setq auto-fill-function
3037 (if (if (null arg)
3038 (not auto-fill-function)
3039 (> (prefix-numeric-value arg) 0))
24ebf92e 3040 normal-auto-fill-function
d7465b15 3041 nil))
7911ecc8 3042 (force-mode-line-update)))
d7465b15
RS
3043
3044;; This holds a document string used to document auto-fill-mode.
3045(defun auto-fill-function ()
3046 "Automatically break line at a previous space, in insertion of text."
3047 nil)
3048
3049(defun turn-on-auto-fill ()
3050 "Unconditionally turn on Auto Fill mode."
3051 (auto-fill-mode 1))
3a99c819
GM
3052
3053(defun turn-off-auto-fill ()
3054 "Unconditionally turn off Auto Fill mode."
3055 (auto-fill-mode -1))
3056
7cbf1dc1 3057(custom-add-option 'text-mode-hook 'turn-on-auto-fill)
d7465b15
RS
3058
3059(defun set-fill-column (arg)
4cc0ea11 3060 "Set `fill-column' to specified argument.
923efb99 3061Use \\[universal-argument] followed by a number to specify a column.
4cc0ea11 3062Just \\[universal-argument] as argument means to use the current column."
d7465b15 3063 (interactive "P")
f4520363
RS
3064 (if (consp arg)
3065 (setq arg (current-column)))
3066 (if (not (integerp arg))
3067 ;; Disallow missing argument; it's probably a typo for C-x C-f.
3068 (error "set-fill-column requires an explicit argument")
3069 (message "Fill column set to %d (was %d)" arg fill-column)
3070 (setq fill-column arg)))
eaae8106 3071
2076c87c 3072(defun set-selective-display (arg)
ff1fbe3e
RS
3073 "Set `selective-display' to ARG; clear it if no arg.
3074When the value of `selective-display' is a number > 0,
3075lines whose indentation is >= that value are not displayed.
3076The variable `selective-display' has a separate value for each buffer."
2076c87c
JB
3077 (interactive "P")
3078 (if (eq selective-display t)
3079 (error "selective-display already in use for marked lines"))
c88ab9ce
ER
3080 (let ((current-vpos
3081 (save-restriction
3082 (narrow-to-region (point-min) (point))
3083 (goto-char (window-start))
3084 (vertical-motion (window-height)))))
3085 (setq selective-display
3086 (and arg (prefix-numeric-value arg)))
3087 (recenter current-vpos))
2076c87c
JB
3088 (set-window-start (selected-window) (window-start (selected-window)))
3089 (princ "selective-display set to " t)
3090 (prin1 selective-display t)
3091 (princ "." t))
3092
4f8f7f9f 3093(defvar overwrite-mode-textual " Ovwrt"
b6a22db0 3094 "The string displayed in the mode line when in overwrite mode.")
4f8f7f9f 3095(defvar overwrite-mode-binary " Bin Ovwrt"
b6a22db0
JB
3096 "The string displayed in the mode line when in binary overwrite mode.")
3097
2076c87c
JB
3098(defun overwrite-mode (arg)
3099 "Toggle overwrite mode.
3100With arg, turn overwrite mode on iff arg is positive.
3101In overwrite mode, printing characters typed in replace existing text
b6a22db0
JB
3102on a one-for-one basis, rather than pushing it to the right. At the
3103end of a line, such characters extend the line. Before a tab,
3104such characters insert until the tab is filled in.
3105\\[quoted-insert] still inserts characters in overwrite mode; this
3106is supposed to make it easier to insert characters when necessary."
3107 (interactive "P")
3108 (setq overwrite-mode
3109 (if (if (null arg) (not overwrite-mode)
3110 (> (prefix-numeric-value arg) 0))
3111 'overwrite-mode-textual))
3112 (force-mode-line-update))
3113
3114(defun binary-overwrite-mode (arg)
3115 "Toggle binary overwrite mode.
3116With arg, turn binary overwrite mode on iff arg is positive.
3117In binary overwrite mode, printing characters typed in replace
3118existing text. Newlines are not treated specially, so typing at the
3119end of a line joins the line to the next, with the typed character
3120between them. Typing before a tab character simply replaces the tab
3121with the character typed.
3122\\[quoted-insert] replaces the text at the cursor, just as ordinary
3123typing characters do.
3124
3125Note that binary overwrite mode is not its own minor mode; it is a
3126specialization of overwrite-mode, entered by setting the
3127`overwrite-mode' variable to `overwrite-mode-binary'."
2076c87c
JB
3128 (interactive "P")
3129 (setq overwrite-mode
b6a22db0 3130 (if (if (null arg)
a61099dd 3131 (not (eq overwrite-mode 'overwrite-mode-binary))
b6a22db0
JB
3132 (> (prefix-numeric-value arg) 0))
3133 'overwrite-mode-binary))
3134 (force-mode-line-update))
eaae8106 3135
69c1dd37
RS
3136(defcustom line-number-mode t
3137 "*Non-nil means display line number in mode line."
3138 :type 'boolean
3139 :group 'editing-basics)
a61099dd
RS
3140
3141(defun line-number-mode (arg)
3142 "Toggle Line Number mode.
3143With arg, turn Line Number mode on iff arg is positive.
3144When Line Number mode is enabled, the line number appears
8dc9e2ef
KH
3145in the mode line.
3146
32f2f98e
EZ
3147Line numbers do not appear for very large buffers and buffers
3148with very long lines; see variables `line-number-display-limit'
3149and `line-number-display-limit-width'."
a61099dd
RS
3150 (interactive "P")
3151 (setq line-number-mode
3152 (if (null arg) (not line-number-mode)
3153 (> (prefix-numeric-value arg) 0)))
3154 (force-mode-line-update))
3155
69c1dd37
RS
3156(defcustom column-number-mode nil
3157 "*Non-nil means display column number in mode line."
3158 :type 'boolean
3159 :group 'editing-basics)
bcad4985
KH
3160
3161(defun column-number-mode (arg)
3162 "Toggle Column Number mode.
3163With arg, turn Column Number mode on iff arg is positive.
3164When Column Number mode is enabled, the column number appears
3165in the mode line."
3166 (interactive "P")
3167 (setq column-number-mode
3168 (if (null arg) (not column-number-mode)
3169 (> (prefix-numeric-value arg) 0)))
3170 (force-mode-line-update))
3171
4b384a8f 3172(defgroup paren-blinking nil
020db25f 3173 "Blinking matching of parens and expressions."
4b384a8f
SM
3174 :prefix "blink-matching-"
3175 :group 'paren-matching)
3176
69c1dd37
RS
3177(defcustom blink-matching-paren t
3178 "*Non-nil means show matching open-paren when close-paren is inserted."
3179 :type 'boolean
4b384a8f 3180 :group 'paren-blinking)
2076c87c 3181
69c1dd37 3182(defcustom blink-matching-paren-on-screen t
29fc44dd 3183 "*Non-nil means show matching open-paren when it is on screen.
4b384a8f
SM
3184If nil, means don't show it (but the open-paren can still be shown
3185when it is off screen)."
69c1dd37 3186 :type 'boolean
4b384a8f 3187 :group 'paren-blinking)
29fc44dd 3188
4b384a8f 3189(defcustom blink-matching-paren-distance (* 25 1024)
69c1dd37
RS
3190 "*If non-nil, is maximum distance to search for matching open-paren."
3191 :type 'integer
4b384a8f 3192 :group 'paren-blinking)
2076c87c 3193
69c1dd37 3194(defcustom blink-matching-delay 1
4b384a8f
SM
3195 "*Time in seconds to delay after showing a matching paren."
3196 :type 'number
3197 :group 'paren-blinking)
72dddf8b 3198
69c1dd37 3199(defcustom blink-matching-paren-dont-ignore-comments nil
4b384a8f 3200 "*Non-nil means `blink-matching-paren' will not ignore comments."
69c1dd37 3201 :type 'boolean
4b384a8f 3202 :group 'paren-blinking)
903b7f65 3203
2076c87c
JB
3204(defun blink-matching-open ()
3205 "Move cursor momentarily to the beginning of the sexp before point."
3206 (interactive)
3207 (and (> (point) (1+ (point-min)))
2076c87c 3208 blink-matching-paren
7e1ddd45
RS
3209 ;; Verify an even number of quoting characters precede the close.
3210 (= 1 (logand 1 (- (point)
3211 (save-excursion
3212 (forward-char -1)
3213 (skip-syntax-backward "/\\")
3214 (point)))))
2076c87c
JB
3215 (let* ((oldpos (point))
3216 (blinkpos)
3217 (mismatch))
3218 (save-excursion
3219 (save-restriction
3220 (if blink-matching-paren-distance
3221 (narrow-to-region (max (point-min)
3222 (- (point) blink-matching-paren-distance))
3223 oldpos))
3224 (condition-case ()
903b7f65
RS
3225 (let ((parse-sexp-ignore-comments
3226 (and parse-sexp-ignore-comments
3227 (not blink-matching-paren-dont-ignore-comments))))
3228 (setq blinkpos (scan-sexps oldpos -1)))
2076c87c 3229 (error nil)))
903b7f65
RS
3230 (and blinkpos
3231 (/= (char-syntax (char-after blinkpos))
3232 ?\$)
2076c87c 3233 (setq mismatch
903b7f65
RS
3234 (or (null (matching-paren (char-after blinkpos)))
3235 (/= (char-after (1- oldpos))
3236 (matching-paren (char-after blinkpos))))))
2076c87c
JB
3237 (if mismatch (setq blinkpos nil))
3238 (if blinkpos
a117eaee
KH
3239 ;; Don't log messages about paren matching.
3240 (let (message-log-max)
2076c87c
JB
3241 (goto-char blinkpos)
3242 (if (pos-visible-in-window-p)
29fc44dd
KH
3243 (and blink-matching-paren-on-screen
3244 (sit-for blink-matching-delay))
2076c87c
JB
3245 (goto-char blinkpos)
3246 (message
3247 "Matches %s"
e9f1d66d 3248 ;; Show what precedes the open in its line, if anything.
2076c87c
JB
3249 (if (save-excursion
3250 (skip-chars-backward " \t")
3251 (not (bolp)))
3252 (buffer-substring (progn (beginning-of-line) (point))
3253 (1+ blinkpos))
e9f1d66d
RS
3254 ;; Show what follows the open in its line, if anything.
3255 (if (save-excursion
3256 (forward-char 1)
3257 (skip-chars-forward " \t")
3258 (not (eolp)))
3259 (buffer-substring blinkpos
3260 (progn (end-of-line) (point)))
267935b9
RS
3261 ;; Otherwise show the previous nonblank line,
3262 ;; if there is one.
3263 (if (save-excursion
3264 (skip-chars-backward "\n \t")
3265 (not (bobp)))
3266 (concat
3267 (buffer-substring (progn
3268 (skip-chars-backward "\n \t")
3269 (beginning-of-line)
3270 (point))
3271 (progn (end-of-line)
3272 (skip-chars-backward " \t")
3273 (point)))
3274 ;; Replace the newline and other whitespace with `...'.
3275 "..."
3276 (buffer-substring blinkpos (1+ blinkpos)))
3277 ;; There is nothing to show except the char itself.
3278 (buffer-substring blinkpos (1+ blinkpos))))))))
2076c87c
JB
3279 (cond (mismatch
3280 (message "Mismatched parentheses"))
3281 ((not blink-matching-paren-distance)
3282 (message "Unmatched parenthesis"))))))))
3283
3284;Turned off because it makes dbx bomb out.
3285(setq blink-paren-function 'blink-matching-open)
3286
9a1277dd
RS
3287;; This executes C-g typed while Emacs is waiting for a command.
3288;; Quitting out of a program does not go through here;
3289;; that happens in the QUIT macro at the C code level.
2076c87c 3290(defun keyboard-quit ()
d5dae4e1 3291 "Signal a `quit' condition.
af39530e
RS
3292During execution of Lisp code, this character causes a quit directly.
3293At top-level, as an editor command, this simply beeps."
2076c87c 3294 (interactive)
19d35374 3295 (deactivate-mark)
2076c87c
JB
3296 (signal 'quit nil))
3297
3298(define-key global-map "\C-g" 'keyboard-quit)
c66587fe 3299
1c6c6fde
RS
3300(defvar buffer-quit-function nil
3301 "Function to call to \"quit\" the current buffer, or nil if none.
3302\\[keyboard-escape-quit] calls this function when its more local actions
3303\(such as cancelling a prefix argument, minibuffer or region) do not apply.")
3304
c66587fe
RS
3305(defun keyboard-escape-quit ()
3306 "Exit the current \"mode\" (in a generalized sense of the word).
3307This command can exit an interactive command such as `query-replace',
3308can clear out a prefix argument or a region,
3309can get out of the minibuffer or other recursive edit,
1c6c6fde
RS
3310cancel the use of the current buffer (for special-purpose buffers),
3311or go back to just one window (by deleting all but the selected window)."
c66587fe
RS
3312 (interactive)
3313 (cond ((eq last-command 'mode-exited) nil)
3314 ((> (minibuffer-depth) 0)
3315 (abort-recursive-edit))
3316 (current-prefix-arg
3317 nil)
3318 ((and transient-mark-mode
3319 mark-active)
3320 (deactivate-mark))
1b657835
RS
3321 ((> (recursion-depth) 0)
3322 (exit-recursive-edit))
1c6c6fde
RS
3323 (buffer-quit-function
3324 (funcall buffer-quit-function))
c66587fe 3325 ((not (one-window-p t))
1b657835
RS
3326 (delete-other-windows))
3327 ((string-match "^ \\*" (buffer-name (current-buffer)))
3328 (bury-buffer))))
c66587fe 3329
1c6c6fde 3330(define-key global-map "\e\e\e" 'keyboard-escape-quit)
22e4ec98 3331
7683b5c2
DL
3332(defcustom read-mail-command 'rmail
3333 "*Your preference for a mail reading package.
9023837e
DL
3334This is used by some keybindings which support reading mail.
3335See also `mail-user-agent' concerning sending mail."
7683b5c2
DL
3336 :type '(choice (function-item rmail)
3337 (function-item gnus)
3338 (function-item mh-rmail)
3339 (function :tag "Other"))
3340 :version "21.1"
3341 :group 'mail)
3342
69c1dd37 3343(defcustom mail-user-agent 'sendmail-user-agent
a31ca314 3344 "*Your preference for a mail composition package.
9023837e 3345Various Emacs Lisp packages (e.g. Reporter) require you to compose an
a31ca314
RS
3346outgoing email message. This variable lets you specify which
3347mail-sending package you prefer.
3348
3349Valid values include:
3350
9023837e
DL
3351 `sendmail-user-agent' -- use the default Emacs Mail package.
3352 See Info node `(emacs)Sending Mail'.
3353 `mh-e-user-agent' -- use the Emacs interface to the MH mail system.
3354 See Info node `(mh-e)'.
3355 `message-user-agent' -- use the Gnus Message package.
3356 See Info node `(message)'.
3357 `gnus-user-agent' -- like `message-user-agent', but with Gnus
3358 paraphernalia, particularly the Gcc: header for
3359 archiving.
a31ca314
RS
3360
3361Additional valid symbols may be available; check with the author of
15d0c9b1
DL
3362your package for details. The function should return non-nil if it
3363succeeds.
9023837e
DL
3364
3365See also `read-mail-command' concerning reading mail."
69c1dd37
RS
3366 :type '(radio (function-item :tag "Default Emacs mail"
3367 :format "%t\n"
3368 sendmail-user-agent)
3369 (function-item :tag "Emacs interface to MH"
3370 :format "%t\n"
3371 mh-e-user-agent)
9023837e 3372 (function-item :tag "Gnus Message package"
69c1dd37
RS
3373 :format "%t\n"
3374 message-user-agent)
9023837e
DL
3375 (function-item :tag "Gnus Message with full Gnus features"
3376 :format "%t\n"
3377 gnus-user-agent)
69c1dd37
RS
3378 (function :tag "Other"))
3379 :group 'mail)
a31ca314
RS
3380
3381(defun define-mail-user-agent (symbol composefunc sendfunc
3382 &optional abortfunc hookvar)
3383 "Define a symbol to identify a mail-sending package for `mail-user-agent'.
3384
3385SYMBOL can be any Lisp symbol. Its function definition and/or
3386value as a variable do not matter for this usage; we use only certain
3387properties on its property list, to encode the rest of the arguments.
3388
3389COMPOSEFUNC is program callable function that composes an outgoing
3390mail message buffer. This function should set up the basics of the
3391buffer without requiring user interaction. It should populate the
3183b230
RS
3392standard mail headers, leaving the `to:' and `subject:' headers blank
3393by default.
a31ca314 3394
d0008a00
RS
3395COMPOSEFUNC should accept several optional arguments--the same
3396arguments that `compose-mail' takes. See that function's documentation.
a31ca314 3397
3183b230
RS
3398SENDFUNC is the command a user would run to send the message.
3399
3400Optional ABORTFUNC is the command a user would run to abort the
a31ca314
RS
3401message. For mail packages that don't have a separate abort function,
3402this can be `kill-buffer' (the equivalent of omitting this argument).
3403
3404Optional HOOKVAR is a hook variable that gets run before the message
3183b230
RS
3405is actually sent. Callers that use the `mail-user-agent' may
3406install a hook function temporarily on this hook variable.
3407If HOOKVAR is nil, `mail-send-hook' is used.
a31ca314
RS
3408
3409The properties used on SYMBOL are `composefunc', `sendfunc',
3410`abortfunc', and `hookvar'."
3411 (put symbol 'composefunc composefunc)
3412 (put symbol 'sendfunc sendfunc)
3413 (put symbol 'abortfunc (or abortfunc 'kill-buffer))
3414 (put symbol 'hookvar (or hookvar 'mail-send-hook)))
3415
3416(define-mail-user-agent 'sendmail-user-agent
34fbcdf3 3417 'sendmail-user-agent-compose
a31ca314
RS
3418 'mail-send-and-exit)
3419
360b5483
RS
3420(defun rfc822-goto-eoh ()
3421 ;; Go to header delimiter line in a mail message, following RFC822 rules
3422 (goto-char (point-min))
3423 (while (looking-at "^[^: \n]+:\\|^[ \t]")
3424 (forward-line 1))
3425 (point))
3426
34fbcdf3
RS
3427(defun sendmail-user-agent-compose (&optional to subject other-headers continue
3428 switch-function yank-action
3429 send-actions)
3430 (if switch-function
3431 (let ((special-display-buffer-names nil)
3432 (special-display-regexps nil)
3433 (same-window-buffer-names nil)
3434 (same-window-regexps nil))
3435 (funcall switch-function "*mail*")))
3436 (let ((cc (cdr (assoc-ignore-case "cc" other-headers)))
0740c738
GM
3437 (in-reply-to (cdr (assoc-ignore-case "in-reply-to" other-headers)))
3438 (body (cdr (assoc-ignore-case "body" other-headers))))
34fbcdf3
RS
3439 (or (mail continue to subject in-reply-to cc yank-action send-actions)
3440 continue
3441 (error "Message aborted"))
3442 (save-excursion
360b5483 3443 (rfc822-goto-eoh)
34fbcdf3 3444 (while other-headers
0740c738
GM
3445 (unless (member-ignore-case (car (car other-headers))
3446 '("in-reply-to" "cc" "body"))
34fbcdf3
RS
3447 (insert (car (car other-headers)) ": "
3448 (cdr (car other-headers)) "\n"))
3449 (setq other-headers (cdr other-headers)))
0740c738
GM
3450 (when body
3451 (forward-line 1)
3452 (insert body))
34fbcdf3
RS
3453 t)))
3454
a31ca314
RS
3455(define-mail-user-agent 'mh-e-user-agent
3456 'mh-smail-batch 'mh-send-letter 'mh-fully-kill-draft
3457 'mh-before-send-letter-hook)
d0008a00
RS
3458
3459(defun compose-mail (&optional to subject other-headers continue
3460 switch-function yank-action send-actions)
3461 "Start composing a mail message to send.
3462This uses the user's chosen mail composition package
3463as selected with the variable `mail-user-agent'.
3464The optional arguments TO and SUBJECT specify recipients
3465and the initial Subject field, respectively.
3466
3467OTHER-HEADERS is an alist specifying additional
3468header fields. Elements look like (HEADER . VALUE) where both
3469HEADER and VALUE are strings.
3470
3471CONTINUE, if non-nil, says to continue editing a message already
3472being composed.
3473
3474SWITCH-FUNCTION, if non-nil, is a function to use to
3475switch to and display the buffer used for mail composition.
3476
3477YANK-ACTION, if non-nil, is an action to perform, if and when necessary,
06720de2
RS
3478to insert the raw text of the message being replied to.
3479It has the form (FUNCTION . ARGS). The user agent will apply
3480FUNCTION to ARGS, to insert the raw text of the original message.
3481\(The user agent will also run `mail-citation-hook', *after* the
3482original text has been inserted in this way.)
d0008a00
RS
3483
3484SEND-ACTIONS is a list of actions to call when the message is sent.
3485Each action has the form (FUNCTION . ARGS)."
b5f019be
RS
3486 (interactive
3487 (list nil nil nil current-prefix-arg))
d0008a00
RS
3488 (let ((function (get mail-user-agent 'composefunc)))
3489 (funcall function to subject other-headers continue
3490 switch-function yank-action send-actions)))
b5f019be
RS
3491
3492(defun compose-mail-other-window (&optional to subject other-headers continue
3493 yank-action send-actions)
3494 "Like \\[compose-mail], but edit the outgoing message in another window."
3495 (interactive
3496 (list nil nil nil current-prefix-arg))
3497 (compose-mail to subject other-headers continue
3498 'switch-to-buffer-other-window yank-action send-actions))
3499
3500
3501(defun compose-mail-other-frame (&optional to subject other-headers continue
3502 yank-action send-actions)
3503 "Like \\[compose-mail], but edit the outgoing message in another frame."
3504 (interactive
3505 (list nil nil nil current-prefix-arg))
3506 (compose-mail to subject other-headers continue
3507 'switch-to-buffer-other-frame yank-action send-actions))
eaae8106 3508
610c1c68
RS
3509(defvar set-variable-value-history nil
3510 "History of values entered with `set-variable'.")
3511
3512(defun set-variable (var val)
3513 "Set VARIABLE to VALUE. VALUE is a Lisp object.
3514When using this interactively, enter a Lisp object for VALUE.
3515If you want VALUE to be a string, you must surround it with doublequotes.
3516VALUE is used literally, not evaluated.
3517
3518If VARIABLE has a `variable-interactive' property, that is used as if
3519it were the arg to `interactive' (which see) to interactively read VALUE.
3520
3521If VARIABLE has been defined with `defcustom', then the type information
3522in the definition is used to check that VALUE is valid."
e9dfb72e
RS
3523 (interactive
3524 (let* ((default-var (variable-at-point))
3525 (var (if (symbolp default-var)
3526 (read-variable (format "Set variable (default %s): " default-var)
3527 default-var)
3528 (read-variable "Set variable: ")))
610c1c68
RS
3529 (minibuffer-help-form '(describe-variable var))
3530 (prop (get var 'variable-interactive))
3531 (prompt (format "Set %s to value: " var))
3532 (val (if prop
3533 ;; Use VAR's `variable-interactive' property
3534 ;; as an interactive spec for prompting.
3535 (call-interactively `(lambda (arg)
3536 (interactive ,prop)
3537 arg))
3538 (read
3539 (read-string prompt nil
3540 'set-variable-value-history)))))
3541 (list var val)))
3542
f8496faa 3543 (let ((type (get var 'custom-type)))
610c1c68
RS
3544 (when type
3545 ;; Match with custom type.
36755dd9 3546 (require 'cus-edit)
610c1c68
RS
3547 (setq type (widget-convert type))
3548 (unless (widget-apply type :match val)
1e722f9f 3549 (error "Value `%S' does not match type %S of %S"
610c1c68 3550 val (car type) var))))
a2aef080
GM
3551 (set var val)
3552
3553 ;; Force a thorough redisplay for the case that the variable
3554 ;; has an effect on the display, like `tab-width' has.
3555 (force-mode-line-update))
eaae8106 3556
e8a700bf
RS
3557;; Define the major mode for lists of completions.
3558
98b45886
RS
3559(defvar completion-list-mode-map nil
3560 "Local map for completion list buffers.")
ac29eb79 3561(or completion-list-mode-map
e8a700bf
RS
3562 (let ((map (make-sparse-keymap)))
3563 (define-key map [mouse-2] 'mouse-choose-completion)
eaf76065 3564 (define-key map [down-mouse-2] nil)
80298193 3565 (define-key map "\C-m" 'choose-completion)
1c6c6fde 3566 (define-key map "\e\e\e" 'delete-completion-window)
dde69dbe
RS
3567 (define-key map [left] 'previous-completion)
3568 (define-key map [right] 'next-completion)
ac29eb79 3569 (setq completion-list-mode-map map)))
e8a700bf
RS
3570
3571;; Completion mode is suitable only for specially formatted data.
ac29eb79 3572(put 'completion-list-mode 'mode-class 'special)
e8a700bf 3573
98b45886
RS
3574(defvar completion-reference-buffer nil
3575 "Record the buffer that was current when the completion list was requested.
3576This is a local variable in the completion list buffer.
ec39964e 3577Initial value is nil to avoid some compiler warnings.")
3819736b 3578
83434bda
RS
3579(defvar completion-no-auto-exit nil
3580 "Non-nil means `choose-completion-string' should never exit the minibuffer.
3581This also applies to other functions such as `choose-completion'
3582and `mouse-choose-completion'.")
3583
98b45886
RS
3584(defvar completion-base-size nil
3585 "Number of chars at beginning of minibuffer not involved in completion.
3586This is a local variable in the completion list buffer
3587but it talks about the buffer in `completion-reference-buffer'.
3588If this is nil, it means to compare text to determine which part
3589of the tail end of the buffer's text is involved in completion.")
f6b293e3 3590
1c6c6fde
RS
3591(defun delete-completion-window ()
3592 "Delete the completion list window.
3593Go to the window from which completion was requested."
3594 (interactive)
3595 (let ((buf completion-reference-buffer))
ddb2b181
RS
3596 (if (one-window-p t)
3597 (if (window-dedicated-p (selected-window))
3598 (delete-frame (selected-frame)))
3599 (delete-window (selected-window))
3600 (if (get-buffer-window buf)
3601 (select-window (get-buffer-window buf))))))
1c6c6fde 3602
dde69dbe
RS
3603(defun previous-completion (n)
3604 "Move to the previous item in the completion list."
3605 (interactive "p")
3606 (next-completion (- n)))
3607
3608(defun next-completion (n)
3609 "Move to the next item in the completion list.
1f238ac2 3610With prefix argument N, move N items (negative N means move backward)."
dde69dbe 3611 (interactive "p")
58dd38f1
SM
3612 (let ((beg (point-min)) (end (point-max)))
3613 (while (and (> n 0) (not (eobp)))
dde69dbe 3614 ;; If in a completion, move to the end of it.
58dd38f1
SM
3615 (when (get-text-property (point) 'mouse-face)
3616 (goto-char (next-single-property-change (point) 'mouse-face nil end)))
dde69dbe 3617 ;; Move to start of next one.
58dd38f1
SM
3618 (unless (get-text-property (point) 'mouse-face)
3619 (goto-char (next-single-property-change (point) 'mouse-face nil end)))
3620 (setq n (1- n)))
3621 (while (and (< n 0) (not (bobp)))
3622 (let ((prop (get-text-property (1- (point)) 'mouse-face)))
3623 ;; If in a completion, move to the start of it.
3624 (when (and prop (eq prop (get-text-property (point) 'mouse-face)))
b61a81c2 3625 (goto-char (previous-single-property-change
58dd38f1
SM
3626 (point) 'mouse-face nil beg)))
3627 ;; Move to end of the previous completion.
3628 (unless (or (bobp) (get-text-property (1- (point)) 'mouse-face))
3629 (goto-char (previous-single-property-change
3630 (point) 'mouse-face nil beg)))
3631 ;; Move to the start of that one.
3632 (goto-char (previous-single-property-change
3633 (point) 'mouse-face nil beg))
3634 (setq n (1+ n))))))
dde69dbe 3635
80298193
RS
3636(defun choose-completion ()
3637 "Choose the completion that point is in or next to."
3638 (interactive)
f6b293e3
RS
3639 (let (beg end completion (buffer completion-reference-buffer)
3640 (base-size completion-base-size))
6096f362
RS
3641 (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
3642 (setq end (point) beg (1+ (point))))
3643 (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
3f299281 3644 (setq end (1- (point)) beg (point)))
6096f362
RS
3645 (if (null beg)
3646 (error "No completion here"))
3647 (setq beg (previous-single-property-change beg 'mouse-face))
88dd3c24 3648 (setq end (or (next-single-property-change end 'mouse-face) (point-max)))
ab63960f
RS
3649 (setq completion (buffer-substring beg end))
3650 (let ((owindow (selected-window)))
3651 (if (and (one-window-p t 'selected-frame)
3652 (window-dedicated-p (selected-window)))
3653 ;; This is a special buffer's frame
3654 (iconify-frame (selected-frame))
3655 (or (window-dedicated-p (selected-window))
3656 (bury-buffer)))
3657 (select-window owindow))
f6b293e3 3658 (choose-completion-string completion buffer base-size)))
80298193
RS
3659
3660;; Delete the longest partial match for STRING
3661;; that can be found before POINT.
3662(defun choose-completion-delete-max-match (string)
3663 (let ((opoint (point))
3664 (len (min (length string)
3665 (- (point) (point-min)))))
3666 (goto-char (- (point) (length string)))
61bbf6fe
RS
3667 (if completion-ignore-case
3668 (setq string (downcase string)))
80298193
RS
3669 (while (and (> len 0)
3670 (let ((tail (buffer-substring (point)
3671 (+ (point) len))))
61bbf6fe
RS
3672 (if completion-ignore-case
3673 (setq tail (downcase tail)))
80298193
RS
3674 (not (string= tail (substring string 0 len)))))
3675 (setq len (1- len))
3676 (forward-char 1))
3677 (delete-char len)))
3678
98b45886
RS
3679;; Switch to BUFFER and insert the completion choice CHOICE.
3680;; BASE-SIZE, if non-nil, says how many characters of BUFFER's text
3681;; to keep. If it is nil, use choose-completion-delete-max-match instead.
74d0290b
RS
3682
3683;; If BUFFER is the minibuffer, exit the minibuffer
83434bda
RS
3684;; unless it is reading a file name and CHOICE is a directory,
3685;; or completion-no-auto-exit is non-nil.
f6b293e3 3686(defun choose-completion-string (choice &optional buffer base-size)
f436a90a
RS
3687 (let ((buffer (or buffer completion-reference-buffer))
3688 (mini-p (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))))
cf52ad58
RS
3689 ;; If BUFFER is a minibuffer, barf unless it's the currently
3690 ;; active minibuffer.
f436a90a 3691 (if (and mini-p
45486731
RS
3692 (or (not (active-minibuffer-window))
3693 (not (equal buffer
3694 (window-buffer (active-minibuffer-window))))))
cf52ad58
RS
3695 (error "Minibuffer is not active for completion")
3696 ;; Insert the completion into the buffer where completion was requested.
3697 (set-buffer buffer)
f6b293e3 3698 (if base-size
f436a90a
RS
3699 (delete-region (+ base-size (if mini-p
3700 (minibuffer-prompt-end)
3701 (point-min)))
3702 (point))
f6b293e3 3703 (choose-completion-delete-max-match choice))
cf52ad58 3704 (insert choice)
63240af1
RS
3705 (remove-text-properties (- (point) (length choice)) (point)
3706 '(mouse-face nil))
cf52ad58
RS
3707 ;; Update point in the window that BUFFER is showing in.
3708 (let ((window (get-buffer-window buffer t)))
3709 (set-window-point window (point)))
3710 ;; If completing for the minibuffer, exit it with this choice.
83434bda
RS
3711 (and (not completion-no-auto-exit)
3712 (equal buffer (window-buffer (minibuffer-window)))
8881ad9a 3713 minibuffer-completion-table
74d0290b
RS
3714 ;; If this is reading a file name, and the file name chosen
3715 ;; is a directory, don't exit the minibuffer.
3716 (if (and (eq minibuffer-completion-table 'read-file-name-internal)
a4d1159b 3717 (file-directory-p (field-string (point-max))))
96e8e603
GM
3718 (let ((mini (active-minibuffer-window)))
3719 (select-window mini)
3720 (when minibuffer-auto-raise
3721 (raise-frame (window-frame mini))))
74d0290b 3722 (exit-minibuffer))))))
80298193 3723
ac29eb79 3724(defun completion-list-mode ()
e8a700bf 3725 "Major mode for buffers showing lists of possible completions.
80298193
RS
3726Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
3727 to select the completion near point.
3728Use \\<completion-list-mode-map>\\[mouse-choose-completion] to select one\
3729 with the mouse."
e8a700bf
RS
3730 (interactive)
3731 (kill-all-local-variables)
ac29eb79
RS
3732 (use-local-map completion-list-mode-map)
3733 (setq mode-name "Completion List")
3734 (setq major-mode 'completion-list-mode)
f6b293e3
RS
3735 (make-local-variable 'completion-base-size)
3736 (setq completion-base-size nil)
ac29eb79 3737 (run-hooks 'completion-list-mode-hook))
e8a700bf 3738
c8d6d636
GM
3739(defun completion-list-mode-finish ()
3740 "Finish setup of the completions buffer.
3741Called from `temp-buffer-show-hook'."
3742 (when (eq major-mode 'completion-list-mode)
3743 (toggle-read-only 1)))
3744
3745(add-hook 'temp-buffer-show-hook 'completion-list-mode-finish)
3746
747a0e2f
RS
3747(defvar completion-setup-hook nil
3748 "Normal hook run at the end of setting up a completion list buffer.
3749When this hook is run, the current buffer is the one in which the
3750command to display the completion list buffer was run.
3751The completion list buffer is available as the value of `standard-output'.")
3752
98b45886
RS
3753;; This function goes in completion-setup-hook, so that it is called
3754;; after the text of the completion list buffer is written.
6096f362 3755
e8a700bf
RS
3756(defun completion-setup-function ()
3757 (save-excursion
98b45886 3758 (let ((mainbuf (current-buffer)))
3819736b
RS
3759 (set-buffer standard-output)
3760 (completion-list-mode)
3761 (make-local-variable 'completion-reference-buffer)
3762 (setq completion-reference-buffer mainbuf)
50be475d
RS
3763 (if (eq minibuffer-completion-table 'read-file-name-internal)
3764 ;; For file name completion,
3765 ;; use the number of chars before the start of the
3766 ;; last file name component.
3767 (setq completion-base-size
3768 (save-excursion
3769 (set-buffer mainbuf)
3770 (goto-char (point-max))
3771 (skip-chars-backward (format "^%c" directory-sep-char))
0aad4805 3772 (- (point) (minibuffer-prompt-end))))
19183a29
RS
3773 ;; Otherwise, in minibuffer, the whole input is being completed.
3774 (save-match-data
3775 (if (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
3776 (buffer-name mainbuf))
3777 (setq completion-base-size 0))))
3819736b 3778 (goto-char (point-min))
0d6e23cf 3779 (if (display-mouse-p)
3819736b 3780 (insert (substitute-command-keys
80298193
RS
3781 "Click \\[mouse-choose-completion] on a completion to select it.\n")))
3782 (insert (substitute-command-keys
3783 "In this buffer, type \\[choose-completion] to \
7d22ed15 3784select the completion near point.\n\n")))))
c88ab9ce 3785
e8a700bf 3786(add-hook 'completion-setup-hook 'completion-setup-function)
dde69dbe
RS
3787
3788(define-key minibuffer-local-completion-map [prior]
3789 'switch-to-completions)
3790(define-key minibuffer-local-must-match-map [prior]
3791 'switch-to-completions)
3792(define-key minibuffer-local-completion-map "\M-v"
3793 'switch-to-completions)
3794(define-key minibuffer-local-must-match-map "\M-v"
3795 'switch-to-completions)
3796
3797(defun switch-to-completions ()
3798 "Select the completion list window."
3799 (interactive)
9595fbdb
RS
3800 ;; Make sure we have a completions window.
3801 (or (get-buffer-window "*Completions*")
3802 (minibuffer-completion-help))
fdbd7c4d
KH
3803 (let ((window (get-buffer-window "*Completions*")))
3804 (when window
3805 (select-window window)
3806 (goto-char (point-min))
3807 (search-forward "\n\n")
3808 (forward-line 1))))
eaae8106 3809
82072f33
RS
3810;; Support keyboard commands to turn on various modifiers.
3811
3812;; These functions -- which are not commands -- each add one modifier
3813;; to the following event.
3814
3815(defun event-apply-alt-modifier (ignore-prompt)
70cf9f08
KH
3816 "Add the Alt modifier to the following event.
3817For example, type \\[event-apply-alt-modifier] & to enter Alt-&."
82072f33
RS
3818 (vector (event-apply-modifier (read-event) 'alt 22 "A-")))
3819(defun event-apply-super-modifier (ignore-prompt)
70cf9f08
KH
3820 "Add the Super modifier to the following event.
3821For example, type \\[event-apply-super-modifier] & to enter Super-&."
82072f33
RS
3822 (vector (event-apply-modifier (read-event) 'super 23 "s-")))
3823(defun event-apply-hyper-modifier (ignore-prompt)
70cf9f08
KH
3824 "Add the Hyper modifier to the following event.
3825For example, type \\[event-apply-hyper-modifier] & to enter Hyper-&."
82072f33
RS
3826 (vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
3827(defun event-apply-shift-modifier (ignore-prompt)
70cf9f08
KH
3828 "Add the Shift modifier to the following event.
3829For example, type \\[event-apply-shift-modifier] & to enter Shift-&."
82072f33
RS
3830 (vector (event-apply-modifier (read-event) 'shift 25 "S-")))
3831(defun event-apply-control-modifier (ignore-prompt)
70cf9f08
KH
3832 "Add the Ctrl modifier to the following event.
3833For example, type \\[event-apply-control-modifier] & to enter Ctrl-&."
82072f33
RS
3834 (vector (event-apply-modifier (read-event) 'control 26 "C-")))
3835(defun event-apply-meta-modifier (ignore-prompt)
70cf9f08
KH
3836 "Add the Meta modifier to the following event.
3837For example, type \\[event-apply-meta-modifier] & to enter Meta-&."
82072f33
RS
3838 (vector (event-apply-modifier (read-event) 'meta 27 "M-")))
3839
3840(defun event-apply-modifier (event symbol lshiftby prefix)
3841 "Apply a modifier flag to event EVENT.
3842SYMBOL is the name of this modifier, as a symbol.
3843LSHIFTBY is the numeric value of this modifier, in keyboard events.
3844PREFIX is the string that represents this modifier in an event type symbol."
3845 (if (numberp event)
3846 (cond ((eq symbol 'control)
90bebcb0
KH
3847 (if (and (<= (downcase event) ?z)
3848 (>= (downcase event) ?a))
82072f33 3849 (- (downcase event) ?a -1)
90bebcb0
KH
3850 (if (and (<= (downcase event) ?Z)
3851 (>= (downcase event) ?A))
82072f33
RS
3852 (- (downcase event) ?A -1)
3853 (logior (lsh 1 lshiftby) event))))
3854 ((eq symbol 'shift)
3855 (if (and (<= (downcase event) ?z)
3856 (>= (downcase event) ?a))
3857 (upcase event)
3858 (logior (lsh 1 lshiftby) event)))
3859 (t
3860 (logior (lsh 1 lshiftby) event)))
3861 (if (memq symbol (event-modifiers event))
3862 event
3863 (let ((event-type (if (symbolp event) event (car event))))
3864 (setq event-type (intern (concat prefix (symbol-name event-type))))
3865 (if (symbolp event)
3866 event-type
3867 (cons event-type (cdr event)))))))
3868
e5fff738
KH
3869(define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier)
3870(define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier)
3871(define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier)
3872(define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier)
3873(define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier)
3874(define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier)
eaae8106 3875
a3d1480b
JB
3876;;;; Keypad support.
3877
3878;;; Make the keypad keys act like ordinary typing keys. If people add
3879;;; bindings for the function key symbols, then those bindings will
3880;;; override these, so this shouldn't interfere with any existing
3881;;; bindings.
3882
0d173134 3883;; Also tell read-char how to handle these keys.
a3d1480b
JB
3884(mapcar
3885 (lambda (keypad-normal)
3886 (let ((keypad (nth 0 keypad-normal))
3887 (normal (nth 1 keypad-normal)))
0d173134 3888 (put keypad 'ascii-character normal)
a3d1480b
JB
3889 (define-key function-key-map (vector keypad) (vector normal))))
3890 '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
3891 (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
3892 (kp-space ?\ )
3893 (kp-tab ?\t)
3894 (kp-enter ?\r)
3895 (kp-multiply ?*)
3896 (kp-add ?+)
3897 (kp-separator ?,)
3898 (kp-subtract ?-)
3899 (kp-decimal ?.)
3900 (kp-divide ?/)
3901 (kp-equal ?=)))
3902
1e722f9f 3903;;;;
b005abd5 3904;;;; forking a twin copy of a buffer.
1e722f9f 3905;;;;
b005abd5
SM
3906
3907(defvar clone-buffer-hook nil
3908 "Normal hook to run in the new buffer at the end of `clone-buffer'.")
3909
3910(defun clone-process (process &optional newname)
3911 "Create a twin copy of PROCESS.
3912If NEWNAME is nil, it defaults to PROCESS' name;
3913NEWNAME is modified by adding or incrementing <N> at the end as necessary.
3914If PROCESS is associated with a buffer, the new process will be associated
3915 with the current buffer instead.
3916Returns nil if PROCESS has already terminated."
3917 (setq newname (or newname (process-name process)))
3918 (if (string-match "<[0-9]+>\\'" newname)
3919 (setq newname (substring newname 0 (match-beginning 0))))
3920 (when (memq (process-status process) '(run stop open))
3921 (let* ((process-connection-type (process-tty-name process))
3922 (old-kwoq (process-kill-without-query process nil))
3923 (new-process
3924 (if (memq (process-status process) '(open))
3925 (apply 'open-network-stream newname
3926 (if (process-buffer process) (current-buffer))
3927 (process-contact process))
3928 (apply 'start-process newname
3929 (if (process-buffer process) (current-buffer))
3930 (process-command process)))))
3931 (process-kill-without-query new-process old-kwoq)
3932 (process-kill-without-query process old-kwoq)
3933 (set-process-inherit-coding-system-flag
3934 new-process (process-inherit-coding-system-flag process))
3935 (set-process-filter new-process (process-filter process))
3936 (set-process-sentinel new-process (process-sentinel process))
3937 new-process)))
3938
3939;; things to maybe add (currently partly covered by `funcall mode':
3940;; - syntax-table
3941;; - overlays
3942(defun clone-buffer (&optional newname display-flag)
3943 "Create a twin copy of the current buffer.
3944If NEWNAME is nil, it defaults to the current buffer's name;
3945NEWNAME is modified by adding or incrementing <N> at the end as necessary.
3946
3947If DISPLAY-FLAG is non-nil, the new buffer is shown with `pop-to-buffer'.
3948This runs the normal hook `clone-buffer-hook' in the new buffer
3949after it has been set up properly in other respects."
3950 (interactive (list (if current-prefix-arg (read-string "Name: "))
3951 t))
3952 (if buffer-file-name
3953 (error "Cannot clone a file-visiting buffer"))
3954 (if (get major-mode 'no-clone)
3955 (error "Cannot clone a buffer in %s mode" mode-name))
3956 (setq newname (or newname (buffer-name)))
3957 (if (string-match "<[0-9]+>\\'" newname)
3958 (setq newname (substring newname 0 (match-beginning 0))))
3959 (let ((buf (current-buffer))
3960 (ptmin (point-min))
3961 (ptmax (point-max))
3962 (pt (point))
3963 (mk (if mark-active (mark t)))
3964 (modified (buffer-modified-p))
3965 (mode major-mode)
3966 (lvars (buffer-local-variables))
3967 (process (get-buffer-process (current-buffer)))
3968 (new (generate-new-buffer (or newname (buffer-name)))))
3969 (save-restriction
3970 (widen)
3971 (with-current-buffer new
3972 (insert-buffer-substring buf)))
3973 (with-current-buffer new
3974 (narrow-to-region ptmin ptmax)
3975 (goto-char pt)
3976 (if mk (set-mark mk))
3977 (set-buffer-modified-p modified)
3978
3979 ;; Clone the old buffer's process, if any.
3980 (when process (clone-process process))
3981
3982 ;; Now set up the major mode.
3983 (funcall mode)
3984
3985 ;; Set up other local variables.
3986 (mapcar (lambda (v)
3987 (condition-case () ;in case var is read-only
3988 (if (symbolp v)
3989 (makunbound v)
3990 (set (make-local-variable (car v)) (cdr v)))
3991 (error nil)))
3992 lvars)
3993
3994 ;; Run any hooks (typically set up by the major mode
3995 ;; for cloning to work properly).
3996 (run-hooks 'clone-buffer-hook))
3997 (if display-flag (pop-to-buffer new))
3998 new))
3999
fa65f20b 4000
7e3afb04 4001(defun clone-indirect-buffer (newname display-flag &optional norecord)
fa65f20b
GM
4002 "Create an indirect buffer that is a twin copy of the current buffer.
4003
4004Give the indirect buffer name NEWNAME. Interactively, read NEW-NAME
4005from the minibuffer when invoked with a prefix arg. If NEWNAME is nil
4006or if not called with a prefix arg, NEWNAME defaults to the current
4007buffer's name. The name is modified by adding a `<N>' suffix to it
4008or by incrementing the N in an existing suffix.
4009
4010DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'.
7e3afb04
GM
4011This is always done when called interactively.
4012
4013Optional last arg NORECORD non-nil means do not put this buffer at the
4014front of the list of recently selected ones."
fa65f20b
GM
4015 (interactive (list (if current-prefix-arg
4016 (read-string "BName of indirect buffer: "))
4017 t))
4018 (setq newname (or newname (buffer-name)))
4019 (if (string-match "<[0-9]+>\\'" newname)
4020 (setq newname (substring newname 0 (match-beginning 0))))
4021 (let* ((name (generate-new-buffer-name newname))
4022 (buffer (make-indirect-buffer (current-buffer) name t)))
4023 (when display-flag
58dd38f1 4024 (pop-to-buffer buffer norecord))
fa65f20b
GM
4025 buffer))
4026
4027
7e3afb04
GM
4028(defun clone-indirect-buffer-other-window (buffer &optional norecord)
4029 "Create an indirect buffer that is a twin copy of BUFFER.
4030Select the new buffer in another window.
4031Optional second arg NORECORD non-nil means do not put this buffer at
4032the front of the list of recently selected ones."
4033 (interactive "bClone buffer in other window: ")
4034 (let ((popup-windows t))
4035 (set-buffer buffer)
4036 (clone-indirect-buffer nil t norecord)))
4037
14583cb1 4038(define-key ctl-x-4-map "c" 'clone-indirect-buffer-other-window)
7e3afb04 4039
eaae8106 4040
f1a9c7b9
GM
4041;;; Syntax stuff.
4042
4043(defconst syntax-code-table
24dad5d5
KH
4044 '((?\ 0 "whitespace")
4045 (?- 0 "whitespace")
4046 (?. 1 "punctuation")
4047 (?w 2 "word")
4048 (?_ 3 "symbol")
4049 (?\( 4 "open parenthesis")
4050 (?\) 5 "close parenthesis")
4051 (?\' 6 "expression prefix")
4052 (?\" 7 "string quote")
4053 (?$ 8 "paired delimiter")
4054 (?\\ 9 "escape")
4055 (?/ 10 "character quote")
4056 (?< 11 "comment start")
4057 (?> 12 "comment end")
4058 (?@ 13 "inherit")
4059 (nil 14 "comment fence")
4060 (nil 15 "string fence"))
4061 "Alist of forms (CHAR CODE DESCRIPTION) mapping characters to syntax info.
f1a9c7b9
GM
4062CHAR is a character that is allowed as first char in the string
4063specifying the syntax when calling `modify-syntax-entry'. CODE is the
4064corresponing syntax code as it is stored in a syntax cell, and
24dad5d5
KH
4065can be used as value of a `syntax-table' property.
4066DESCRIPTION is the descriptive string for the syntax.")
f1a9c7b9 4067
eaae8106 4068
1d4b11bf
GM
4069;;; Handling of Backspace and Delete keys.
4070
7f62656b
EZ
4071(defcustom normal-erase-is-backspace nil
4072 "If non-nil, Delete key deletes forward and Backspace key deletes backward.
1d4b11bf
GM
4073
4074On window systems, the default value of this option is chosen
4075according to the keyboard used. If the keyboard has both a Backspace
4076key and a Delete key, and both are mapped to their usual meanings, the
4077option's default value is set to t, so that Backspace can be used to
7f62656b 4078delete backward, and Delete can be used to delete forward.
1d4b11bf 4079
7f62656b 4080If not running under a window system, customizing this option accomplishes
1d4b11bf
GM
4081a similar effect by mapping C-h, which is usually generated by the
4082Backspace key, to DEL, and by mapping DEL to C-d via
4083`keyboard-translate'. The former functionality of C-h is available on
4084the F1 key. You should probably not use this setting if you don't
f060b834
GM
4085have both Backspace, Delete and F1 keys.
4086
4087Setting this variable with setq doesn't take effect. Programmatically,
7f62656b 4088call `normal-erase-is-backspace-mode' (which see) instead."
1d4b11bf
GM
4089 :type 'boolean
4090 :group 'editing-basics
4091 :version "21.1"
4092 :set (lambda (symbol value)
4093 ;; The fboundp is because of a problem with :set when
4094 ;; dumping Emacs. It doesn't really matter.
7f62656b
EZ
4095 (if (fboundp 'normal-erase-is-backspace-mode)
4096 (normal-erase-is-backspace-mode (or value 0))
1d4b11bf
GM
4097 (set-default symbol value))))
4098
4099
7f62656b
EZ
4100(defun normal-erase-is-backspace-mode (&optional arg)
4101 "Toggle the Erase and Delete mode of the Backspace and Delete keys.
4102
e02160a3 4103With numeric arg, turn the mode on if and only if ARG is positive.
7f62656b
EZ
4104
4105On window systems, when this mode is on, Delete is mapped to C-d and
4106Backspace is mapped to DEL; when this mode is off, both Delete and
4107Backspace are mapped to DEL. (The remapping goes via
4108`function-key-map', so binding Delete or Backspace in the global or
4109local keymap will override that.)
4110
4111In addition, on window systems, the bindings of C-Delete, M-Delete,
4112C-M-Delete, C-Backspace, M-Backspace, and C-M-Backspace are changed in
4113the global keymap in accordance with the functionality of Delete and
4114Backspace. For example, if Delete is remapped to C-d, which deletes
4115forward, C-Delete is bound to `kill-word', but if Delete is remapped
4116to DEL, which deletes backward, C-Delete is bound to
4117`backward-kill-word'.
4118
4119If not running on a window system, a similar effect is accomplished by
4120remapping C-h (normally produced by the Backspace key) and DEL via
4121`keyboard-translate': if this mode is on, C-h is mapped to DEL and DEL
4122to C-d; if it's off, the keys are not remapped.
4123
4124When not running on a window system, and this mode is turned on, the
4125former functionality of C-h is available on the F1 key. You should
4126probably not turn on this mode on a text-only terminal if you don't
4127have both Backspace, Delete and F1 keys.
4128
4129See also `normal-erase-is-backspace'."
1d4b11bf 4130 (interactive "P")
7f62656b 4131 (setq normal-erase-is-backspace
1d4b11bf
GM
4132 (if arg
4133 (> (prefix-numeric-value arg) 0)
7f62656b 4134 (not normal-erase-is-backspace)))
1d4b11bf 4135
13a9eed7
EZ
4136 (cond ((or (memq window-system '(x w32 mac pc))
4137 (memq system-type '(ms-dos windows-nt)))
7f62656b 4138 (let ((bindings
103db06c
RS
4139 `(([C-delete] [C-backspace])
4140 ([M-delete] [M-backspace])
4141 ([C-M-delete] [C-M-backspace])
ec9f4754 4142 (,esc-map
103db06c
RS
4143 [C-delete] [C-backspace])))
4144 (old-state (lookup-key function-key-map [delete])))
ec9f4754 4145
7f62656b 4146 (if normal-erase-is-backspace
ec9f4754
GM
4147 (progn
4148 (define-key function-key-map [delete] [?\C-d])
be4f1e41 4149 (define-key function-key-map [kp-delete] [?\C-d])
ec9f4754
GM
4150 (define-key function-key-map [backspace] [?\C-?]))
4151 (define-key function-key-map [delete] [?\C-?])
be4f1e41 4152 (define-key function-key-map [kp-delete] [?\C-?])
ec9f4754
GM
4153 (define-key function-key-map [backspace] [?\C-?]))
4154
103db06c
RS
4155 ;; Maybe swap bindings of C-delete and C-backspace, etc.
4156 (unless (equal old-state (lookup-key function-key-map [delete]))
4157 (dolist (binding bindings)
4158 (let ((map global-map))
4159 (when (keymapp (car binding))
4160 (setq map (car binding) binding (cdr binding)))
4161 (let* ((key1 (nth 0 binding))
4162 (key2 (nth 1 binding))
4163 (binding1 (lookup-key map key1))
4164 (binding2 (lookup-key map key2)))
4165 (define-key map key1 binding2)
4166 (define-key map key2 binding1)))))))
1d4b11bf 4167 (t
7f62656b 4168 (if normal-erase-is-backspace
1d4b11bf
GM
4169 (progn
4170 (keyboard-translate ?\C-h ?\C-?)
4171 (keyboard-translate ?\C-? ?\C-d))
4172 (keyboard-translate ?\C-h ?\C-h)
4173 (keyboard-translate ?\C-? ?\C-?))))
4174
7f62656b 4175 (run-hooks 'normal-erase-is-backspace-hook)
1d4b11bf 4176 (if (interactive-p)
7f62656b
EZ
4177 (message "Delete key deletes %s"
4178 (if normal-erase-is-backspace "forward" "backward"))))
4179
1d4b11bf 4180
9985d391
GM
4181;;; Misc
4182
4183(defun byte-compiling-files-p ()
4184 "Return t if currently byte-compiling files."
4185 (and (boundp 'byte-compile-current-file)
4186 (stringp byte-compile-current-file)))
eaae8106 4187
c88ab9ce 4188;;; simple.el ends here