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