(speedbar-tag-hierarchy-method)
[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)))))
2d88b556 375\f
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)))
2d88b556 436\f
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))))))
2d88b556 562\f
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))))
2d88b556 678\f
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)))
2d88b556 889\f
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))))
2d88b556 1522\f
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))
2d88b556 1638\f
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.")
2d88b556 1675\f
70e14c01 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 1699 "Make STRING the latest kill in the kill ring.
3e505153 1700Set `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))
2d88b556 1951\f
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)))
2d88b556 2132\f
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)))))
2d88b556 2214\f
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)))
2d88b556 2419\f
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
41d22ee0 2532 (if (not (memq last-command '(next-line previous-line)))
2596511d
RS
2533 (setq temporary-goal-column
2534 (if (and track-eol (eolp)
2535 ;; Don't count beg of empty line as end of line
2536 ;; unless we just did explicit end-of-line.
2537 (or (not (bolp)) (eq last-command 'end-of-line)))
2538 9999
2539 (current-column))))
2540 (if (and (not (integerp selective-display))
2541 (not line-move-ignore-invisible))
2542 ;; Use just newline characters.
e9cd25fe 2543 ;; Set ARG to 0 if we move as many lines as requested.
2596511d
RS
2544 (or (if (> arg 0)
2545 (progn (if (> arg 1) (forward-line (1- arg)))
2546 ;; This way of moving forward ARG lines
2547 ;; verifies that we have a newline after the last one.
2548 ;; It doesn't get confused by intangible text.
2549 (end-of-line)
e9cd25fe
RS
2550 (if (zerop (forward-line 1))
2551 (setq arg 0)))
2596511d 2552 (and (zerop (forward-line arg))
e9cd25fe
RS
2553 (bolp)
2554 (setq arg 0)))
2596511d
RS
2555 (signal (if (< arg 0)
2556 'beginning-of-buffer
e9cd25fe 2557 'end-of-buffer)
2596511d
RS
2558 nil))
2559 ;; Move by arg lines, but ignore invisible ones.
2560 (while (> arg 0)
af894fc9
RS
2561 ;; If the following character is currently invisible,
2562 ;; skip all characters with that same `invisible' property value.
2563 (while (and (not (eobp)) (line-move-invisible (point)))
2564 (goto-char (next-char-property-change (point))))
2565 ;; Now move a line.
2596511d
RS
2566 (end-of-line)
2567 (and (zerop (vertical-motion 1))
2568 (signal 'end-of-buffer nil))
2596511d
RS
2569 (setq arg (1- arg)))
2570 (while (< arg 0)
2571 (beginning-of-line)
2572 (and (zerop (vertical-motion -1))
2573 (signal 'beginning-of-buffer nil))
af894fc9
RS
2574 (setq arg (1+ arg))
2575 (while (and (not (bobp)) (line-move-invisible (1- (point))))
2576 (goto-char (previous-char-property-change (point)))))))
2577
e9cd25fe
RS
2578 (cond ((> arg 0)
2579 ;; If we did not move down as far as desired,
2580 ;; at least go to end of line.
2581 (end-of-line))
2582 ((< arg 0)
2583 ;; If we did not move down as far as desired,
2584 ;; at least go to end of line.
2585 (beginning-of-line))
2586 (t
2587 (line-move-finish (or goal-column temporary-goal-column) opoint)))))
2596511d 2588 nil)
2076c87c 2589
af894fc9
RS
2590(defun line-move-finish (column opoint)
2591 (let ((repeat t))
2592 (while repeat
2593 ;; Set REPEAT to t to repeat the whole thing.
2594 (setq repeat nil)
2595
2596 ;; Move to the desired column.
2597 (line-move-to-column column)
2598
2599 (let ((new (point))
2600 (line-beg (save-excursion (beginning-of-line) (point)))
2601 (line-end (save-excursion (end-of-line) (point))))
2602
2603 ;; Process intangibility within a line.
2604 ;; Move to the chosen destination position from above,
2605 ;; with intangibility processing enabled.
2606
2607 (goto-char (point-min))
2608 (let ((inhibit-point-motion-hooks nil))
2609 (goto-char new)
2610
2611 ;; If intangibility moves us to a different (later) place
2612 ;; in the same line, use that as the destination.
2613 (if (<= (point) line-end)
2614 (setq new (point))))
2615
2616 ;; Now move to the updated destination, processing fields
2617 ;; as well as intangibility.
2618 (goto-char opoint)
2619 (let ((inhibit-point-motion-hooks nil))
2620 (goto-char
2621 (constrain-to-field new opoint nil t
2622 'inhibit-line-move-field-capture)))
2623
2624 ;; If intangibility processing moved us to a different line,
2625 ;; retry everything within that new line.
2626 (when (or (< (point) line-beg) (> (point) line-end))
2627 ;; Repeat the intangibility and field processing.
2628 (setq repeat t))))))
2629
2630(defun line-move-to-column (col)
2631 "Try to find column COL, considering invisibility.
2632This function works only in certain cases,
2633because what we really need is for `move-to-column'
2634and `current-column' to be able to ignore invisible text."
a615252b
RS
2635 (if (zerop col)
2636 (beginning-of-line)
2637 (move-to-column col))
af894fc9
RS
2638
2639 (when (and line-move-ignore-invisible
2640 (not (bolp)) (line-move-invisible (1- (point))))
2641 (let ((normal-location (point))
2642 (normal-column (current-column)))
2643 ;; If the following character is currently invisible,
2644 ;; skip all characters with that same `invisible' property value.
2645 (while (and (not (eobp))
2646 (line-move-invisible (point)))
2647 (goto-char (next-char-property-change (point))))
2648 ;; Have we advanced to a larger column position?
2649 (if (> (current-column) normal-column)
2650 ;; We have made some progress towards the desired column.
2651 ;; See if we can make any further progress.
2652 (line-move-to-column (+ (current-column) (- col normal-column)))
2653 ;; Otherwise, go to the place we originally found
2654 ;; and move back over invisible text.
2655 ;; that will get us to the same place on the screen
2656 ;; but with a more reasonable buffer position.
2657 (goto-char normal-location)
2658 (let ((line-beg (save-excursion (beginning-of-line) (point))))
2659 (while (and (not (bolp)) (line-move-invisible (1- (point))))
2660 (goto-char (previous-char-property-change (point) line-beg))))))))
2661
d5ab2033
JB
2662;;; Many people have said they rarely use this feature, and often type
2663;;; it by accident. Maybe it shouldn't even be on a key.
2664(put 'set-goal-column 'disabled t)
2076c87c
JB
2665
2666(defun set-goal-column (arg)
2667 "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
2668Those commands will move to this position in the line moved to
2669rather than trying to keep the same horizontal position.
2670With a non-nil argument, clears out the goal column
912c6728
RS
2671so that \\[next-line] and \\[previous-line] resume vertical motion.
2672The goal column is stored in the variable `goal-column'."
2076c87c
JB
2673 (interactive "P")
2674 (if arg
2675 (progn
2676 (setq goal-column nil)
2677 (message "No goal column"))
2678 (setq goal-column (current-column))
2679 (message (substitute-command-keys
2680 "Goal column %d (use \\[set-goal-column] with an arg to unset it)")
2681 goal-column))
2682 nil)
2d88b556 2683\f
7492f5a6
RS
2684
2685(defun scroll-other-window-down (lines)
e47d38f6
RS
2686 "Scroll the \"other window\" down.
2687For more details, see the documentation for `scroll-other-window'."
7492f5a6
RS
2688 (interactive "P")
2689 (scroll-other-window
2690 ;; Just invert the argument's meaning.
2691 ;; We can do that without knowing which window it will be.
2692 (if (eq lines '-) nil
2693 (if (null lines) '-
2694 (- (prefix-numeric-value lines))))))
e47d38f6 2695(define-key esc-map [?\C-\S-v] 'scroll-other-window-down)
3aef9604
RS
2696
2697(defun beginning-of-buffer-other-window (arg)
2698 "Move point to the beginning of the buffer in the other window.
2699Leave mark at previous position.
2700With arg N, put point N/10 of the way from the true beginning."
2701 (interactive "P")
2702 (let ((orig-window (selected-window))
2703 (window (other-window-for-scrolling)))
2704 ;; We use unwind-protect rather than save-window-excursion
2705 ;; because the latter would preserve the things we want to change.
2706 (unwind-protect
2707 (progn
2708 (select-window window)
2709 ;; Set point and mark in that window's buffer.
2710 (beginning-of-buffer arg)
2711 ;; Set point accordingly.
2712 (recenter '(t)))
2713 (select-window orig-window))))
2714
2715(defun end-of-buffer-other-window (arg)
2716 "Move point to the end of the buffer in the other window.
2717Leave mark at previous position.
2718With arg N, put point N/10 of the way from the true end."
2719 (interactive "P")
2720 ;; See beginning-of-buffer-other-window for comments.
2721 (let ((orig-window (selected-window))
2722 (window (other-window-for-scrolling)))
2723 (unwind-protect
2724 (progn
2725 (select-window window)
4500ff36 2726 (end-of-buffer arg)
3aef9604
RS
2727 (recenter '(t)))
2728 (select-window orig-window))))
2d88b556 2729\f
2076c87c
JB
2730(defun transpose-chars (arg)
2731 "Interchange characters around point, moving forward one character.
2732With prefix arg ARG, effect is to take character before point
2733and drag it forward past ARG other characters (backward if ARG negative).
2734If no argument and at end of line, the previous two chars are exchanged."
2735 (interactive "*P")
2736 (and (null arg) (eolp) (forward-char -1))
2737 (transpose-subr 'forward-char (prefix-numeric-value arg)))
2738
2739(defun transpose-words (arg)
2740 "Interchange words around point, leaving point at end of them.
2741With prefix arg ARG, effect is to take word before or around point
2742and drag it forward past ARG other words (backward if ARG negative).
2743If ARG is zero, the words around or after point and around or after mark
2744are interchanged."
41d22ee0 2745 ;; FIXME: `foo a!nd bar' should transpose into `bar and foo'.
2076c87c
JB
2746 (interactive "*p")
2747 (transpose-subr 'forward-word arg))
2748
2749(defun transpose-sexps (arg)
2750 "Like \\[transpose-words] but applies to sexps.
2751Does not work on a sexp that point is in the middle of
2752if it is a list or string."
2753 (interactive "*p")
41d22ee0
SM
2754 (transpose-subr
2755 (lambda (arg)
2756 ;; Here we should try to simulate the behavior of
2757 ;; (cons (progn (forward-sexp x) (point))
2758 ;; (progn (forward-sexp (- x)) (point)))
2759 ;; Except that we don't want to rely on the second forward-sexp
2760 ;; putting us back to where we want to be, since forward-sexp-function
2761 ;; might do funny things like infix-precedence.
2762 (if (if (> arg 0)
2763 (looking-at "\\sw\\|\\s_")
2764 (and (not (bobp))
2765 (save-excursion (forward-char -1) (looking-at "\\sw\\|\\s_"))))
2766 ;; Jumping over a symbol. We might be inside it, mind you.
2767 (progn (funcall (if (> arg 0)
2768 'skip-syntax-backward 'skip-syntax-forward)
2769 "w_")
2770 (cons (save-excursion (forward-sexp arg) (point)) (point)))
2771 ;; Otherwise, we're between sexps. Take a step back before jumping
2772 ;; to make sure we'll obey the same precedence no matter which direction
2773 ;; we're going.
2774 (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward) " .")
2775 (cons (save-excursion (forward-sexp arg) (point))
2776 (progn (while (or (forward-comment (if (> arg 0) 1 -1))
2777 (not (zerop (funcall (if (> arg 0)
2778 'skip-syntax-forward
2779 'skip-syntax-backward)
2780 ".")))))
2781 (point)))))
2782 arg 'special))
2076c87c
JB
2783
2784(defun transpose-lines (arg)
2785 "Exchange current line and previous line, leaving point after both.
2786With argument ARG, takes previous line and moves it past ARG lines.
2787With argument 0, interchanges line point is in with line mark is in."
2788 (interactive "*p")
2789 (transpose-subr (function
2790 (lambda (arg)
d3f4ef3f 2791 (if (> arg 0)
2076c87c 2792 (progn
d3f4ef3f
AS
2793 ;; Move forward over ARG lines,
2794 ;; but create newlines if necessary.
2795 (setq arg (forward-line arg))
2796 (if (/= (preceding-char) ?\n)
2797 (setq arg (1+ arg)))
2798 (if (> arg 0)
2799 (newline arg)))
2076c87c
JB
2800 (forward-line arg))))
2801 arg))
2802
e1e04350
SM
2803(defun transpose-subr (mover arg &optional special)
2804 (let ((aux (if special mover
2805 (lambda (x)
2806 (cons (progn (funcall mover x) (point))
2807 (progn (funcall mover (- x)) (point))))))
2808 pos1 pos2)
2809 (cond
2810 ((= arg 0)
2811 (save-excursion
2812 (setq pos1 (funcall aux 1))
2813 (goto-char (mark))
2814 (setq pos2 (funcall aux 1))
2815 (transpose-subr-1 pos1 pos2))
2816 (exchange-point-and-mark))
2817 ((> arg 0)
2818 (setq pos1 (funcall aux -1))
2819 (setq pos2 (funcall aux arg))
2820 (transpose-subr-1 pos1 pos2)
2821 (goto-char (car pos2)))
2822 (t
2823 (setq pos1 (funcall aux -1))
2824 (goto-char (car pos1))
2825 (setq pos2 (funcall aux arg))
2826 (transpose-subr-1 pos1 pos2)))))
2827
2828(defun transpose-subr-1 (pos1 pos2)
2829 (when (> (car pos1) (cdr pos1)) (setq pos1 (cons (cdr pos1) (car pos1))))
2830 (when (> (car pos2) (cdr pos2)) (setq pos2 (cons (cdr pos2) (car pos2))))
2831 (when (> (car pos1) (car pos2))
2832 (let ((swap pos1))
2833 (setq pos1 pos2 pos2 swap)))
2834 (if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose"))
dc7d7552
RS
2835 (atomic-change-group
2836 (let (word2)
2837 (setq word2 (delete-and-extract-region (car pos2) (cdr pos2)))
2838 (goto-char (car pos2))
2839 (insert (delete-and-extract-region (car pos1) (cdr pos1)))
2840 (goto-char (car pos1))
2841 (insert word2))))
2d88b556 2842\f
2076c87c 2843(defun backward-word (arg)
b7e91b0c 2844 "Move backward until encountering the beginning of a word.
20ecc110 2845With argument, do this that many times."
9e50756b 2846 (interactive "p")
2076c87c
JB
2847 (forward-word (- arg)))
2848
2849(defun mark-word (arg)
cad113ae
KG
2850 "Set mark arg words away from point.
2851If this command is repeated, it marks the next ARG words after the ones
2852already marked."
2076c87c 2853 (interactive "p")
cad113ae
KG
2854 (cond ((and (eq last-command this-command) (mark t))
2855 (set-mark
2856 (save-excursion
2857 (goto-char (mark))
2858 (forward-word arg)
2859 (point))))
2860 (t
2861 (push-mark
2862 (save-excursion
2863 (forward-word arg)
2864 (point))
2865 nil t))))
2076c87c
JB
2866
2867(defun kill-word (arg)
2868 "Kill characters forward until encountering the end of a word.
2869With argument, do this that many times."
e761e42c 2870 (interactive "p")
89ee2bf6 2871 (kill-region (point) (progn (forward-word arg) (point))))
2076c87c
JB
2872
2873(defun backward-kill-word (arg)
2874 "Kill characters backward until encountering the end of a word.
2875With argument, do this that many times."
e761e42c 2876 (interactive "p")
2076c87c 2877 (kill-word (- arg)))
d7c64071 2878
1e8c5ac4
RS
2879(defun current-word (&optional strict)
2880 "Return the word point is on (or a nearby word) as a string.
2881If optional arg STRICT is non-nil, return nil unless point is within
2882or adjacent to a word."
d7c64071
ER
2883 (save-excursion
2884 (let ((oldpoint (point)) (start (point)) (end (point)))
2885 (skip-syntax-backward "w_") (setq start (point))
2886 (goto-char oldpoint)
2887 (skip-syntax-forward "w_") (setq end (point))
2888 (if (and (eq start oldpoint) (eq end oldpoint))
1e8c5ac4
RS
2889 ;; Point is neither within nor adjacent to a word.
2890 (and (not strict)
2891 (progn
2892 ;; Look for preceding word in same line.
2893 (skip-syntax-backward "^w_"
2894 (save-excursion (beginning-of-line)
2895 (point)))
2896 (if (bolp)
2897 ;; No preceding word in same line.
2898 ;; Look for following word in same line.
2899 (progn
2900 (skip-syntax-forward "^w_"
2901 (save-excursion (end-of-line)
2902 (point)))
2903 (setq start (point))
2904 (skip-syntax-forward "w_")
2905 (setq end (point)))
2906 (setq end (point))
2907 (skip-syntax-backward "w_")
2908 (setq start (point)))
020db25f
RS
2909 (buffer-substring-no-properties start end)))
2910 (buffer-substring-no-properties start end)))))
2d88b556 2911\f
69c1dd37 2912(defcustom fill-prefix nil
e1e04350 2913 "*String for filling to insert at front of new line, or nil for none."
69c1dd37
RS
2914 :type '(choice (const :tag "None" nil)
2915 string)
2916 :group 'fill)
2076c87c
JB
2917(make-variable-buffer-local 'fill-prefix)
2918
69c1dd37
RS
2919(defcustom auto-fill-inhibit-regexp nil
2920 "*Regexp to match lines which should not be auto-filled."
2921 :type '(choice (const :tag "None" nil)
2922 regexp)
2923 :group 'fill)
2076c87c 2924
58dd38f1 2925(defvar comment-line-break-function 'comment-indent-new-line
b3ac9fa9
RS
2926 "*Mode-specific function which line breaks and continues a comment.
2927
2928This function is only called during auto-filling of a comment section.
2929The function should take a single optional argument, which is a flag
2930indicating whether it should use soft newlines.
2931
2932Setting this variable automatically makes it local to the current buffer.")
2933
dbe524b6 2934;; This function is used as the auto-fill-function of a buffer
e2504204
KH
2935;; when Auto-Fill mode is enabled.
2936;; It returns t if it really did any work.
dbe524b6
RS
2937;; (Actually some major modes use a different auto-fill function,
2938;; but this one is the default one.)
2076c87c 2939(defun do-auto-fill ()
a0170800
RS
2940 (let (fc justify bol give-up
2941 (fill-prefix fill-prefix))
c18465c4 2942 (if (or (not (setq justify (current-justification)))
8f066a20
RS
2943 (null (setq fc (current-fill-column)))
2944 (and (eq justify 'left)
2945 (<= (current-column) fc))
1e722f9f 2946 (save-excursion (beginning-of-line)
eed5698b
RS
2947 (setq bol (point))
2948 (and auto-fill-inhibit-regexp
2949 (looking-at auto-fill-inhibit-regexp))))
2950 nil ;; Auto-filling not required
3db1e3b5
BG
2951 (if (memq justify '(full center right))
2952 (save-excursion (unjustify-current-line)))
a0170800
RS
2953
2954 ;; Choose a fill-prefix automatically.
e1e04350
SM
2955 (when (and adaptive-fill-mode
2956 (or (null fill-prefix) (string= fill-prefix "")))
2957 (let ((prefix
2958 (fill-context-prefix
2959 (save-excursion (backward-paragraph 1) (point))
2960 (save-excursion (forward-paragraph 1) (point)))))
2961 (and prefix (not (equal prefix ""))
2962 ;; Use auto-indentation rather than a guessed empty prefix.
2963 (not (and fill-indent-according-to-mode
2964 (string-match "[ \t]*" prefix)))
2965 (setq fill-prefix prefix))))
2966
eed5698b 2967 (while (and (not give-up) (> (current-column) fc))
e47d38f6 2968 ;; Determine where to split the line.
db893d00
RS
2969 (let* (after-prefix
2970 (fill-point
41d22ee0 2971 (let ((opoint (point)))
db893d00
RS
2972 (save-excursion
2973 (beginning-of-line)
2974 (setq after-prefix (point))
2975 (and fill-prefix
2976 (looking-at (regexp-quote fill-prefix))
2977 (setq after-prefix (match-end 0)))
2978 (move-to-column (1+ fc))
41d22ee0 2979 (fill-move-to-break-point after-prefix)
db893d00
RS
2980 (point)))))
2981
2982 ;; See whether the place we found is any good.
e47d38f6
RS
2983 (if (save-excursion
2984 (goto-char fill-point)
41d22ee0
SM
2985 (or (bolp)
2986 ;; There is no use breaking at end of line.
2987 (save-excursion (skip-chars-forward " ") (eolp))
2988 ;; It is futile to split at the end of the prefix
2989 ;; since we would just insert the prefix again.
2990 (and after-prefix (<= (point) after-prefix))
2991 ;; Don't split right after a comment starter
2992 ;; since we would just make another comment starter.
2993 (and comment-start-skip
2994 (let ((limit (point)))
2995 (beginning-of-line)
2996 (and (re-search-forward comment-start-skip
2997 limit t)
2998 (eq (point) limit))))))
2999 ;; No good place to break => stop trying.
3000 (setq give-up t)
3001 ;; Ok, we have a useful place to break the line. Do it.
3002 (let ((prev-column (current-column)))
3003 ;; If point is at the fill-point, do not `save-excursion'.
3004 ;; Otherwise, if a comment prefix or fill-prefix is inserted,
3005 ;; point will end up before it rather than after it.
3006 (if (save-excursion
3007 (skip-chars-backward " \t")
3008 (= (point) fill-point))
3009 (funcall comment-line-break-function t)
3010 (save-excursion
3011 (goto-char fill-point)
3012 (funcall comment-line-break-function t)))
3013 ;; Now do justification, if required
3014 (if (not (eq justify 'left))
e47d38f6 3015 (save-excursion
e1e04350
SM
3016 (end-of-line 0)
3017 (justify-current-line justify nil t)))
41d22ee0
SM
3018 ;; If making the new line didn't reduce the hpos of
3019 ;; the end of the line, then give up now;
3020 ;; trying again will not help.
3021 (if (>= (current-column) prev-column)
3022 (setq give-up t))))))
24ebf92e 3023 ;; Justify last line.
e2504204 3024 (justify-current-line justify t t)
1e722f9f 3025 t)))
2076c87c 3026
24ebf92e
RS
3027(defvar normal-auto-fill-function 'do-auto-fill
3028 "The function to use for `auto-fill-function' if Auto Fill mode is turned on.
3029Some major modes set this.")
3030
d7465b15 3031(defun auto-fill-mode (&optional arg)
24ebf92e
RS
3032 "Toggle Auto Fill mode.
3033With arg, turn Auto Fill mode on if and only if arg is positive.
3034In Auto Fill mode, inserting a space at a column beyond `current-fill-column'
3035automatically breaks the line at a previous space.
3036
3037The value of `normal-auto-fill-function' specifies the function to use
3038for `auto-fill-function' when turning Auto Fill mode on."
d7465b15
RS
3039 (interactive "P")
3040 (prog1 (setq auto-fill-function
3041 (if (if (null arg)
3042 (not auto-fill-function)
3043 (> (prefix-numeric-value arg) 0))
24ebf92e 3044 normal-auto-fill-function
d7465b15 3045 nil))
7911ecc8 3046 (force-mode-line-update)))
d7465b15
RS
3047
3048;; This holds a document string used to document auto-fill-mode.
3049(defun auto-fill-function ()
3050 "Automatically break line at a previous space, in insertion of text."
3051 nil)
3052
3053(defun turn-on-auto-fill ()
3054 "Unconditionally turn on Auto Fill mode."
3055 (auto-fill-mode 1))
3a99c819
GM
3056
3057(defun turn-off-auto-fill ()
3058 "Unconditionally turn off Auto Fill mode."
3059 (auto-fill-mode -1))
3060
7cbf1dc1 3061(custom-add-option 'text-mode-hook 'turn-on-auto-fill)
d7465b15
RS
3062
3063(defun set-fill-column (arg)
4cc0ea11 3064 "Set `fill-column' to specified argument.
923efb99 3065Use \\[universal-argument] followed by a number to specify a column.
4cc0ea11 3066Just \\[universal-argument] as argument means to use the current column."
d7465b15 3067 (interactive "P")
f4520363
RS
3068 (if (consp arg)
3069 (setq arg (current-column)))
3070 (if (not (integerp arg))
3071 ;; Disallow missing argument; it's probably a typo for C-x C-f.
3072 (error "set-fill-column requires an explicit argument")
3073 (message "Fill column set to %d (was %d)" arg fill-column)
3074 (setq fill-column arg)))
2d88b556 3075\f
2076c87c 3076(defun set-selective-display (arg)
ff1fbe3e
RS
3077 "Set `selective-display' to ARG; clear it if no arg.
3078When the value of `selective-display' is a number > 0,
3079lines whose indentation is >= that value are not displayed.
3080The variable `selective-display' has a separate value for each buffer."
2076c87c
JB
3081 (interactive "P")
3082 (if (eq selective-display t)
3083 (error "selective-display already in use for marked lines"))
c88ab9ce
ER
3084 (let ((current-vpos
3085 (save-restriction
3086 (narrow-to-region (point-min) (point))
3087 (goto-char (window-start))
3088 (vertical-motion (window-height)))))
3089 (setq selective-display
3090 (and arg (prefix-numeric-value arg)))
3091 (recenter current-vpos))
2076c87c
JB
3092 (set-window-start (selected-window) (window-start (selected-window)))
3093 (princ "selective-display set to " t)
3094 (prin1 selective-display t)
3095 (princ "." t))
3096
4f8f7f9f 3097(defvar overwrite-mode-textual " Ovwrt"
b6a22db0 3098 "The string displayed in the mode line when in overwrite mode.")
4f8f7f9f 3099(defvar overwrite-mode-binary " Bin Ovwrt"
b6a22db0
JB
3100 "The string displayed in the mode line when in binary overwrite mode.")
3101
2076c87c
JB
3102(defun overwrite-mode (arg)
3103 "Toggle overwrite mode.
3104With arg, turn overwrite mode on iff arg is positive.
3105In overwrite mode, printing characters typed in replace existing text
b6a22db0
JB
3106on a one-for-one basis, rather than pushing it to the right. At the
3107end of a line, such characters extend the line. Before a tab,
3108such characters insert until the tab is filled in.
3109\\[quoted-insert] still inserts characters in overwrite mode; this
3110is supposed to make it easier to insert characters when necessary."
3111 (interactive "P")
3112 (setq overwrite-mode
3113 (if (if (null arg) (not overwrite-mode)
3114 (> (prefix-numeric-value arg) 0))
3115 'overwrite-mode-textual))
3116 (force-mode-line-update))
3117
3118(defun binary-overwrite-mode (arg)
3119 "Toggle binary overwrite mode.
3120With arg, turn binary overwrite mode on iff arg is positive.
3121In binary overwrite mode, printing characters typed in replace
3122existing text. Newlines are not treated specially, so typing at the
3123end of a line joins the line to the next, with the typed character
3124between them. Typing before a tab character simply replaces the tab
3125with the character typed.
3126\\[quoted-insert] replaces the text at the cursor, just as ordinary
3127typing characters do.
3128
3129Note that binary overwrite mode is not its own minor mode; it is a
3130specialization of overwrite-mode, entered by setting the
3131`overwrite-mode' variable to `overwrite-mode-binary'."
2076c87c
JB
3132 (interactive "P")
3133 (setq overwrite-mode
b6a22db0 3134 (if (if (null arg)
a61099dd 3135 (not (eq overwrite-mode 'overwrite-mode-binary))
b6a22db0
JB
3136 (> (prefix-numeric-value arg) 0))
3137 'overwrite-mode-binary))
3138 (force-mode-line-update))
eaae8106 3139
69c1dd37
RS
3140(defcustom line-number-mode t
3141 "*Non-nil means display line number in mode line."
3142 :type 'boolean
3143 :group 'editing-basics)
a61099dd
RS
3144
3145(defun line-number-mode (arg)
3146 "Toggle Line Number mode.
3147With arg, turn Line Number mode on iff arg is positive.
3148When Line Number mode is enabled, the line number appears
8dc9e2ef
KH
3149in the mode line.
3150
32f2f98e
EZ
3151Line numbers do not appear for very large buffers and buffers
3152with very long lines; see variables `line-number-display-limit'
3153and `line-number-display-limit-width'."
a61099dd
RS
3154 (interactive "P")
3155 (setq line-number-mode
3156 (if (null arg) (not line-number-mode)
3157 (> (prefix-numeric-value arg) 0)))
3158 (force-mode-line-update))
3159
69c1dd37
RS
3160(defcustom column-number-mode nil
3161 "*Non-nil means display column number in mode line."
3162 :type 'boolean
3163 :group 'editing-basics)
bcad4985
KH
3164
3165(defun column-number-mode (arg)
3166 "Toggle Column Number mode.
3167With arg, turn Column Number mode on iff arg is positive.
3168When Column Number mode is enabled, the column number appears
3169in the mode line."
3170 (interactive "P")
3171 (setq column-number-mode
3172 (if (null arg) (not column-number-mode)
3173 (> (prefix-numeric-value arg) 0)))
3174 (force-mode-line-update))
2d88b556 3175\f
4b384a8f 3176(defgroup paren-blinking nil
020db25f 3177 "Blinking matching of parens and expressions."
4b384a8f
SM
3178 :prefix "blink-matching-"
3179 :group 'paren-matching)
3180
69c1dd37
RS
3181(defcustom blink-matching-paren t
3182 "*Non-nil means show matching open-paren when close-paren is inserted."
3183 :type 'boolean
4b384a8f 3184 :group 'paren-blinking)
2076c87c 3185
69c1dd37 3186(defcustom blink-matching-paren-on-screen t
29fc44dd 3187 "*Non-nil means show matching open-paren when it is on screen.
4b384a8f
SM
3188If nil, means don't show it (but the open-paren can still be shown
3189when it is off screen)."
69c1dd37 3190 :type 'boolean
4b384a8f 3191 :group 'paren-blinking)
29fc44dd 3192
4b384a8f 3193(defcustom blink-matching-paren-distance (* 25 1024)
69c1dd37
RS
3194 "*If non-nil, is maximum distance to search for matching open-paren."
3195 :type 'integer
4b384a8f 3196 :group 'paren-blinking)
2076c87c 3197
69c1dd37 3198(defcustom blink-matching-delay 1
4b384a8f
SM
3199 "*Time in seconds to delay after showing a matching paren."
3200 :type 'number
3201 :group 'paren-blinking)
72dddf8b 3202
69c1dd37 3203(defcustom blink-matching-paren-dont-ignore-comments nil
4b384a8f 3204 "*Non-nil means `blink-matching-paren' will not ignore comments."
69c1dd37 3205 :type 'boolean
4b384a8f 3206 :group 'paren-blinking)
903b7f65 3207
2076c87c
JB
3208(defun blink-matching-open ()
3209 "Move cursor momentarily to the beginning of the sexp before point."
3210 (interactive)
3211 (and (> (point) (1+ (point-min)))
2076c87c 3212 blink-matching-paren
7e1ddd45
RS
3213 ;; Verify an even number of quoting characters precede the close.
3214 (= 1 (logand 1 (- (point)
3215 (save-excursion
3216 (forward-char -1)
3217 (skip-syntax-backward "/\\")
3218 (point)))))
2076c87c
JB
3219 (let* ((oldpos (point))
3220 (blinkpos)
3221 (mismatch))
3222 (save-excursion
3223 (save-restriction
3224 (if blink-matching-paren-distance
3225 (narrow-to-region (max (point-min)
3226 (- (point) blink-matching-paren-distance))
3227 oldpos))
3228 (condition-case ()
903b7f65
RS
3229 (let ((parse-sexp-ignore-comments
3230 (and parse-sexp-ignore-comments
3231 (not blink-matching-paren-dont-ignore-comments))))
3232 (setq blinkpos (scan-sexps oldpos -1)))
2076c87c 3233 (error nil)))
903b7f65
RS
3234 (and blinkpos
3235 (/= (char-syntax (char-after blinkpos))
3236 ?\$)
2076c87c 3237 (setq mismatch
903b7f65
RS
3238 (or (null (matching-paren (char-after blinkpos)))
3239 (/= (char-after (1- oldpos))
3240 (matching-paren (char-after blinkpos))))))
2076c87c
JB
3241 (if mismatch (setq blinkpos nil))
3242 (if blinkpos
a117eaee
KH
3243 ;; Don't log messages about paren matching.
3244 (let (message-log-max)
2076c87c
JB
3245 (goto-char blinkpos)
3246 (if (pos-visible-in-window-p)
29fc44dd
KH
3247 (and blink-matching-paren-on-screen
3248 (sit-for blink-matching-delay))
2076c87c
JB
3249 (goto-char blinkpos)
3250 (message
3251 "Matches %s"
e9f1d66d 3252 ;; Show what precedes the open in its line, if anything.
2076c87c
JB
3253 (if (save-excursion
3254 (skip-chars-backward " \t")
3255 (not (bolp)))
3256 (buffer-substring (progn (beginning-of-line) (point))
3257 (1+ blinkpos))
e9f1d66d
RS
3258 ;; Show what follows the open in its line, if anything.
3259 (if (save-excursion
3260 (forward-char 1)
3261 (skip-chars-forward " \t")
3262 (not (eolp)))
3263 (buffer-substring blinkpos
3264 (progn (end-of-line) (point)))
267935b9
RS
3265 ;; Otherwise show the previous nonblank line,
3266 ;; if there is one.
3267 (if (save-excursion
3268 (skip-chars-backward "\n \t")
3269 (not (bobp)))
3270 (concat
3271 (buffer-substring (progn
3272 (skip-chars-backward "\n \t")
3273 (beginning-of-line)
3274 (point))
3275 (progn (end-of-line)
3276 (skip-chars-backward " \t")
3277 (point)))
3278 ;; Replace the newline and other whitespace with `...'.
3279 "..."
3280 (buffer-substring blinkpos (1+ blinkpos)))
3281 ;; There is nothing to show except the char itself.
3282 (buffer-substring blinkpos (1+ blinkpos))))))))
2076c87c
JB
3283 (cond (mismatch
3284 (message "Mismatched parentheses"))
3285 ((not blink-matching-paren-distance)
3286 (message "Unmatched parenthesis"))))))))
3287
3288;Turned off because it makes dbx bomb out.
3289(setq blink-paren-function 'blink-matching-open)
2d88b556 3290\f
9a1277dd
RS
3291;; This executes C-g typed while Emacs is waiting for a command.
3292;; Quitting out of a program does not go through here;
3293;; that happens in the QUIT macro at the C code level.
2076c87c 3294(defun keyboard-quit ()
d5dae4e1 3295 "Signal a `quit' condition.
af39530e
RS
3296During execution of Lisp code, this character causes a quit directly.
3297At top-level, as an editor command, this simply beeps."
2076c87c 3298 (interactive)
19d35374 3299 (deactivate-mark)
2076c87c
JB
3300 (signal 'quit nil))
3301
3302(define-key global-map "\C-g" 'keyboard-quit)
c66587fe 3303
1c6c6fde
RS
3304(defvar buffer-quit-function nil
3305 "Function to call to \"quit\" the current buffer, or nil if none.
3306\\[keyboard-escape-quit] calls this function when its more local actions
3307\(such as cancelling a prefix argument, minibuffer or region) do not apply.")
3308
c66587fe
RS
3309(defun keyboard-escape-quit ()
3310 "Exit the current \"mode\" (in a generalized sense of the word).
3311This command can exit an interactive command such as `query-replace',
3312can clear out a prefix argument or a region,
3313can get out of the minibuffer or other recursive edit,
1c6c6fde
RS
3314cancel the use of the current buffer (for special-purpose buffers),
3315or go back to just one window (by deleting all but the selected window)."
c66587fe
RS
3316 (interactive)
3317 (cond ((eq last-command 'mode-exited) nil)
3318 ((> (minibuffer-depth) 0)
3319 (abort-recursive-edit))
3320 (current-prefix-arg
3321 nil)
3322 ((and transient-mark-mode
3323 mark-active)
3324 (deactivate-mark))
1b657835
RS
3325 ((> (recursion-depth) 0)
3326 (exit-recursive-edit))
1c6c6fde
RS
3327 (buffer-quit-function
3328 (funcall buffer-quit-function))
c66587fe 3329 ((not (one-window-p t))
1b657835
RS
3330 (delete-other-windows))
3331 ((string-match "^ \\*" (buffer-name (current-buffer)))
3332 (bury-buffer))))
c66587fe 3333
2d88b556
RS
3334(defun play-sound-file (file &optional volume device)
3335 "Play sound stored in FILE.
3336VOLUME and DEVICE correspond to the keywords of the sound
3337specification for `play-sound'."
3338 (interactive "fPlay sound file: ")
3339 (let ((sound (list :file file)))
3340 (if volume
3341 (plist-put sound :volume volume))
3342 (if device
3343 (plist-put sound :device device))
3344 (push 'sound sound)
3345 (play-sound sound)))
3346
1c6c6fde 3347(define-key global-map "\e\e\e" 'keyboard-escape-quit)
22e4ec98 3348
7683b5c2
DL
3349(defcustom read-mail-command 'rmail
3350 "*Your preference for a mail reading package.
9023837e
DL
3351This is used by some keybindings which support reading mail.
3352See also `mail-user-agent' concerning sending mail."
7683b5c2
DL
3353 :type '(choice (function-item rmail)
3354 (function-item gnus)
3355 (function-item mh-rmail)
3356 (function :tag "Other"))
3357 :version "21.1"
3358 :group 'mail)
3359
69c1dd37 3360(defcustom mail-user-agent 'sendmail-user-agent
a31ca314 3361 "*Your preference for a mail composition package.
9023837e 3362Various Emacs Lisp packages (e.g. Reporter) require you to compose an
a31ca314
RS
3363outgoing email message. This variable lets you specify which
3364mail-sending package you prefer.
3365
3366Valid values include:
3367
9023837e
DL
3368 `sendmail-user-agent' -- use the default Emacs Mail package.
3369 See Info node `(emacs)Sending Mail'.
3370 `mh-e-user-agent' -- use the Emacs interface to the MH mail system.
3371 See Info node `(mh-e)'.
3372 `message-user-agent' -- use the Gnus Message package.
3373 See Info node `(message)'.
3374 `gnus-user-agent' -- like `message-user-agent', but with Gnus
3375 paraphernalia, particularly the Gcc: header for
3376 archiving.
a31ca314
RS
3377
3378Additional valid symbols may be available; check with the author of
15d0c9b1
DL
3379your package for details. The function should return non-nil if it
3380succeeds.
9023837e
DL
3381
3382See also `read-mail-command' concerning reading mail."
69c1dd37
RS
3383 :type '(radio (function-item :tag "Default Emacs mail"
3384 :format "%t\n"
3385 sendmail-user-agent)
3386 (function-item :tag "Emacs interface to MH"
3387 :format "%t\n"
3388 mh-e-user-agent)
9023837e 3389 (function-item :tag "Gnus Message package"
69c1dd37
RS
3390 :format "%t\n"
3391 message-user-agent)
9023837e
DL
3392 (function-item :tag "Gnus Message with full Gnus features"
3393 :format "%t\n"
3394 gnus-user-agent)
69c1dd37
RS
3395 (function :tag "Other"))
3396 :group 'mail)
a31ca314
RS
3397
3398(defun define-mail-user-agent (symbol composefunc sendfunc
3399 &optional abortfunc hookvar)
3400 "Define a symbol to identify a mail-sending package for `mail-user-agent'.
3401
3402SYMBOL can be any Lisp symbol. Its function definition and/or
3403value as a variable do not matter for this usage; we use only certain
3404properties on its property list, to encode the rest of the arguments.
3405
3406COMPOSEFUNC is program callable function that composes an outgoing
3407mail message buffer. This function should set up the basics of the
3408buffer without requiring user interaction. It should populate the
3183b230
RS
3409standard mail headers, leaving the `to:' and `subject:' headers blank
3410by default.
a31ca314 3411
d0008a00
RS
3412COMPOSEFUNC should accept several optional arguments--the same
3413arguments that `compose-mail' takes. See that function's documentation.
a31ca314 3414
3183b230
RS
3415SENDFUNC is the command a user would run to send the message.
3416
3417Optional ABORTFUNC is the command a user would run to abort the
a31ca314
RS
3418message. For mail packages that don't have a separate abort function,
3419this can be `kill-buffer' (the equivalent of omitting this argument).
3420
3421Optional HOOKVAR is a hook variable that gets run before the message
3183b230
RS
3422is actually sent. Callers that use the `mail-user-agent' may
3423install a hook function temporarily on this hook variable.
3424If HOOKVAR is nil, `mail-send-hook' is used.
a31ca314
RS
3425
3426The properties used on SYMBOL are `composefunc', `sendfunc',
3427`abortfunc', and `hookvar'."
3428 (put symbol 'composefunc composefunc)
3429 (put symbol 'sendfunc sendfunc)
3430 (put symbol 'abortfunc (or abortfunc 'kill-buffer))
3431 (put symbol 'hookvar (or hookvar 'mail-send-hook)))
3432
3433(define-mail-user-agent 'sendmail-user-agent
34fbcdf3 3434 'sendmail-user-agent-compose
a31ca314
RS
3435 'mail-send-and-exit)
3436
360b5483
RS
3437(defun rfc822-goto-eoh ()
3438 ;; Go to header delimiter line in a mail message, following RFC822 rules
3439 (goto-char (point-min))
e1e04350
SM
3440 (when (re-search-forward
3441 "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
3442 (goto-char (match-beginning 0))))
360b5483 3443
34fbcdf3
RS
3444(defun sendmail-user-agent-compose (&optional to subject other-headers continue
3445 switch-function yank-action
3446 send-actions)
3447 (if switch-function
3448 (let ((special-display-buffer-names nil)
3449 (special-display-regexps nil)
3450 (same-window-buffer-names nil)
3451 (same-window-regexps nil))
3452 (funcall switch-function "*mail*")))
3453 (let ((cc (cdr (assoc-ignore-case "cc" other-headers)))
0740c738
GM
3454 (in-reply-to (cdr (assoc-ignore-case "in-reply-to" other-headers)))
3455 (body (cdr (assoc-ignore-case "body" other-headers))))
34fbcdf3
RS
3456 (or (mail continue to subject in-reply-to cc yank-action send-actions)
3457 continue
3458 (error "Message aborted"))
3459 (save-excursion
360b5483 3460 (rfc822-goto-eoh)
34fbcdf3 3461 (while other-headers
0740c738
GM
3462 (unless (member-ignore-case (car (car other-headers))
3463 '("in-reply-to" "cc" "body"))
34fbcdf3
RS
3464 (insert (car (car other-headers)) ": "
3465 (cdr (car other-headers)) "\n"))
3466 (setq other-headers (cdr other-headers)))
0740c738
GM
3467 (when body
3468 (forward-line 1)
3469 (insert body))
34fbcdf3
RS
3470 t)))
3471
a31ca314
RS
3472(define-mail-user-agent 'mh-e-user-agent
3473 'mh-smail-batch 'mh-send-letter 'mh-fully-kill-draft
3474 'mh-before-send-letter-hook)
d0008a00
RS
3475
3476(defun compose-mail (&optional to subject other-headers continue
3477 switch-function yank-action send-actions)
3478 "Start composing a mail message to send.
3479This uses the user's chosen mail composition package
3480as selected with the variable `mail-user-agent'.
3481The optional arguments TO and SUBJECT specify recipients
3482and the initial Subject field, respectively.
3483
3484OTHER-HEADERS is an alist specifying additional
3485header fields. Elements look like (HEADER . VALUE) where both
3486HEADER and VALUE are strings.
3487
3488CONTINUE, if non-nil, says to continue editing a message already
3489being composed.
3490
3491SWITCH-FUNCTION, if non-nil, is a function to use to
3492switch to and display the buffer used for mail composition.
3493
3494YANK-ACTION, if non-nil, is an action to perform, if and when necessary,
06720de2
RS
3495to insert the raw text of the message being replied to.
3496It has the form (FUNCTION . ARGS). The user agent will apply
3497FUNCTION to ARGS, to insert the raw text of the original message.
3498\(The user agent will also run `mail-citation-hook', *after* the
3499original text has been inserted in this way.)
d0008a00
RS
3500
3501SEND-ACTIONS is a list of actions to call when the message is sent.
3502Each action has the form (FUNCTION . ARGS)."
b5f019be
RS
3503 (interactive
3504 (list nil nil nil current-prefix-arg))
d0008a00
RS
3505 (let ((function (get mail-user-agent 'composefunc)))
3506 (funcall function to subject other-headers continue
3507 switch-function yank-action send-actions)))
b5f019be
RS
3508
3509(defun compose-mail-other-window (&optional to subject other-headers continue
3510 yank-action send-actions)
3511 "Like \\[compose-mail], but edit the outgoing message in another window."
3512 (interactive
3513 (list nil nil nil current-prefix-arg))
3514 (compose-mail to subject other-headers continue
3515 'switch-to-buffer-other-window yank-action send-actions))
3516
3517
3518(defun compose-mail-other-frame (&optional to subject other-headers continue
3519 yank-action send-actions)
3520 "Like \\[compose-mail], but edit the outgoing message in another frame."
3521 (interactive
3522 (list nil nil nil current-prefix-arg))
3523 (compose-mail to subject other-headers continue
3524 'switch-to-buffer-other-frame yank-action send-actions))
eaae8106 3525
610c1c68
RS
3526(defvar set-variable-value-history nil
3527 "History of values entered with `set-variable'.")
3528
3529(defun set-variable (var val)
3530 "Set VARIABLE to VALUE. VALUE is a Lisp object.
3531When using this interactively, enter a Lisp object for VALUE.
3532If you want VALUE to be a string, you must surround it with doublequotes.
3533VALUE is used literally, not evaluated.
3534
3535If VARIABLE has a `variable-interactive' property, that is used as if
3536it were the arg to `interactive' (which see) to interactively read VALUE.
3537
3538If VARIABLE has been defined with `defcustom', then the type information
3539in the definition is used to check that VALUE is valid."
e9dfb72e
RS
3540 (interactive
3541 (let* ((default-var (variable-at-point))
3542 (var (if (symbolp default-var)
3543 (read-variable (format "Set variable (default %s): " default-var)
3544 default-var)
3545 (read-variable "Set variable: ")))
610c1c68
RS
3546 (minibuffer-help-form '(describe-variable var))
3547 (prop (get var 'variable-interactive))
3548 (prompt (format "Set %s to value: " var))
3549 (val (if prop
3550 ;; Use VAR's `variable-interactive' property
3551 ;; as an interactive spec for prompting.
3552 (call-interactively `(lambda (arg)
3553 (interactive ,prop)
3554 arg))
3555 (read
3556 (read-string prompt nil
3557 'set-variable-value-history)))))
3558 (list var val)))
3559
f8496faa 3560 (let ((type (get var 'custom-type)))
610c1c68
RS
3561 (when type
3562 ;; Match with custom type.
36755dd9 3563 (require 'cus-edit)
610c1c68
RS
3564 (setq type (widget-convert type))
3565 (unless (widget-apply type :match val)
1e722f9f 3566 (error "Value `%S' does not match type %S of %S"
610c1c68 3567 val (car type) var))))
a2aef080
GM
3568 (set var val)
3569
3570 ;; Force a thorough redisplay for the case that the variable
3571 ;; has an effect on the display, like `tab-width' has.
3572 (force-mode-line-update))
eaae8106 3573
e8a700bf
RS
3574;; Define the major mode for lists of completions.
3575
98b45886
RS
3576(defvar completion-list-mode-map nil
3577 "Local map for completion list buffers.")
ac29eb79 3578(or completion-list-mode-map
e8a700bf
RS
3579 (let ((map (make-sparse-keymap)))
3580 (define-key map [mouse-2] 'mouse-choose-completion)
eaf76065 3581 (define-key map [down-mouse-2] nil)
80298193 3582 (define-key map "\C-m" 'choose-completion)
1c6c6fde 3583 (define-key map "\e\e\e" 'delete-completion-window)
dde69dbe
RS
3584 (define-key map [left] 'previous-completion)
3585 (define-key map [right] 'next-completion)
ac29eb79 3586 (setq completion-list-mode-map map)))
e8a700bf
RS
3587
3588;; Completion mode is suitable only for specially formatted data.
ac29eb79 3589(put 'completion-list-mode 'mode-class 'special)
e8a700bf 3590
98b45886
RS
3591(defvar completion-reference-buffer nil
3592 "Record the buffer that was current when the completion list was requested.
3593This is a local variable in the completion list buffer.
ec39964e 3594Initial value is nil to avoid some compiler warnings.")
3819736b 3595
83434bda
RS
3596(defvar completion-no-auto-exit nil
3597 "Non-nil means `choose-completion-string' should never exit the minibuffer.
3598This also applies to other functions such as `choose-completion'
3599and `mouse-choose-completion'.")
3600
98b45886
RS
3601(defvar completion-base-size nil
3602 "Number of chars at beginning of minibuffer not involved in completion.
3603This is a local variable in the completion list buffer
3604but it talks about the buffer in `completion-reference-buffer'.
3605If this is nil, it means to compare text to determine which part
3606of the tail end of the buffer's text is involved in completion.")
f6b293e3 3607
1c6c6fde
RS
3608(defun delete-completion-window ()
3609 "Delete the completion list window.
3610Go to the window from which completion was requested."
3611 (interactive)
3612 (let ((buf completion-reference-buffer))
ddb2b181
RS
3613 (if (one-window-p t)
3614 (if (window-dedicated-p (selected-window))
3615 (delete-frame (selected-frame)))
3616 (delete-window (selected-window))
3617 (if (get-buffer-window buf)
3618 (select-window (get-buffer-window buf))))))
1c6c6fde 3619
dde69dbe
RS
3620(defun previous-completion (n)
3621 "Move to the previous item in the completion list."
3622 (interactive "p")
3623 (next-completion (- n)))
3624
3625(defun next-completion (n)
3626 "Move to the next item in the completion list.
1f238ac2 3627With prefix argument N, move N items (negative N means move backward)."
dde69dbe 3628 (interactive "p")
58dd38f1
SM
3629 (let ((beg (point-min)) (end (point-max)))
3630 (while (and (> n 0) (not (eobp)))
dde69dbe 3631 ;; If in a completion, move to the end of it.
58dd38f1
SM
3632 (when (get-text-property (point) 'mouse-face)
3633 (goto-char (next-single-property-change (point) 'mouse-face nil end)))
dde69dbe 3634 ;; Move to start of next one.
58dd38f1
SM
3635 (unless (get-text-property (point) 'mouse-face)
3636 (goto-char (next-single-property-change (point) 'mouse-face nil end)))
3637 (setq n (1- n)))
3638 (while (and (< n 0) (not (bobp)))
3639 (let ((prop (get-text-property (1- (point)) 'mouse-face)))
3640 ;; If in a completion, move to the start of it.
3641 (when (and prop (eq prop (get-text-property (point) 'mouse-face)))
b61a81c2 3642 (goto-char (previous-single-property-change
58dd38f1
SM
3643 (point) 'mouse-face nil beg)))
3644 ;; Move to end of the previous completion.
3645 (unless (or (bobp) (get-text-property (1- (point)) 'mouse-face))
3646 (goto-char (previous-single-property-change
3647 (point) 'mouse-face nil beg)))
3648 ;; Move to the start of that one.
3649 (goto-char (previous-single-property-change
3650 (point) 'mouse-face nil beg))
3651 (setq n (1+ n))))))
dde69dbe 3652
80298193
RS
3653(defun choose-completion ()
3654 "Choose the completion that point is in or next to."
3655 (interactive)
f6b293e3
RS
3656 (let (beg end completion (buffer completion-reference-buffer)
3657 (base-size completion-base-size))
6096f362
RS
3658 (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
3659 (setq end (point) beg (1+ (point))))
3660 (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
3f299281 3661 (setq end (1- (point)) beg (point)))
6096f362
RS
3662 (if (null beg)
3663 (error "No completion here"))
3664 (setq beg (previous-single-property-change beg 'mouse-face))
88dd3c24 3665 (setq end (or (next-single-property-change end 'mouse-face) (point-max)))
ab63960f
RS
3666 (setq completion (buffer-substring beg end))
3667 (let ((owindow (selected-window)))
3668 (if (and (one-window-p t 'selected-frame)
3669 (window-dedicated-p (selected-window)))
3670 ;; This is a special buffer's frame
3671 (iconify-frame (selected-frame))
3672 (or (window-dedicated-p (selected-window))
3673 (bury-buffer)))
3674 (select-window owindow))
f6b293e3 3675 (choose-completion-string completion buffer base-size)))
80298193
RS
3676
3677;; Delete the longest partial match for STRING
3678;; that can be found before POINT.
3679(defun choose-completion-delete-max-match (string)
3680 (let ((opoint (point))
3681 (len (min (length string)
3682 (- (point) (point-min)))))
3683 (goto-char (- (point) (length string)))
61bbf6fe
RS
3684 (if completion-ignore-case
3685 (setq string (downcase string)))
80298193
RS
3686 (while (and (> len 0)
3687 (let ((tail (buffer-substring (point)
3688 (+ (point) len))))
61bbf6fe
RS
3689 (if completion-ignore-case
3690 (setq tail (downcase tail)))
80298193
RS
3691 (not (string= tail (substring string 0 len)))))
3692 (setq len (1- len))
3693 (forward-char 1))
3694 (delete-char len)))
3695
98b45886
RS
3696;; Switch to BUFFER and insert the completion choice CHOICE.
3697;; BASE-SIZE, if non-nil, says how many characters of BUFFER's text
3698;; to keep. If it is nil, use choose-completion-delete-max-match instead.
74d0290b
RS
3699
3700;; If BUFFER is the minibuffer, exit the minibuffer
83434bda
RS
3701;; unless it is reading a file name and CHOICE is a directory,
3702;; or completion-no-auto-exit is non-nil.
f6b293e3 3703(defun choose-completion-string (choice &optional buffer base-size)
f436a90a
RS
3704 (let ((buffer (or buffer completion-reference-buffer))
3705 (mini-p (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))))
cf52ad58
RS
3706 ;; If BUFFER is a minibuffer, barf unless it's the currently
3707 ;; active minibuffer.
f436a90a 3708 (if (and mini-p
45486731
RS
3709 (or (not (active-minibuffer-window))
3710 (not (equal buffer
3711 (window-buffer (active-minibuffer-window))))))
cf52ad58
RS
3712 (error "Minibuffer is not active for completion")
3713 ;; Insert the completion into the buffer where completion was requested.
3714 (set-buffer buffer)
f6b293e3 3715 (if base-size
f436a90a
RS
3716 (delete-region (+ base-size (if mini-p
3717 (minibuffer-prompt-end)
3718 (point-min)))
3719 (point))
f6b293e3 3720 (choose-completion-delete-max-match choice))
cf52ad58 3721 (insert choice)
63240af1
RS
3722 (remove-text-properties (- (point) (length choice)) (point)
3723 '(mouse-face nil))
cf52ad58
RS
3724 ;; Update point in the window that BUFFER is showing in.
3725 (let ((window (get-buffer-window buffer t)))
3726 (set-window-point window (point)))
3727 ;; If completing for the minibuffer, exit it with this choice.
83434bda
RS
3728 (and (not completion-no-auto-exit)
3729 (equal buffer (window-buffer (minibuffer-window)))
8881ad9a 3730 minibuffer-completion-table
74d0290b
RS
3731 ;; If this is reading a file name, and the file name chosen
3732 ;; is a directory, don't exit the minibuffer.
3733 (if (and (eq minibuffer-completion-table 'read-file-name-internal)
a4d1159b 3734 (file-directory-p (field-string (point-max))))
96e8e603
GM
3735 (let ((mini (active-minibuffer-window)))
3736 (select-window mini)
3737 (when minibuffer-auto-raise
3738 (raise-frame (window-frame mini))))
74d0290b 3739 (exit-minibuffer))))))
80298193 3740
ac29eb79 3741(defun completion-list-mode ()
e8a700bf 3742 "Major mode for buffers showing lists of possible completions.
80298193
RS
3743Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
3744 to select the completion near point.
3745Use \\<completion-list-mode-map>\\[mouse-choose-completion] to select one\
3746 with the mouse."
e8a700bf
RS
3747 (interactive)
3748 (kill-all-local-variables)
ac29eb79
RS
3749 (use-local-map completion-list-mode-map)
3750 (setq mode-name "Completion List")
3751 (setq major-mode 'completion-list-mode)
f6b293e3
RS
3752 (make-local-variable 'completion-base-size)
3753 (setq completion-base-size nil)
ac29eb79 3754 (run-hooks 'completion-list-mode-hook))
e8a700bf 3755
c8d6d636
GM
3756(defun completion-list-mode-finish ()
3757 "Finish setup of the completions buffer.
3758Called from `temp-buffer-show-hook'."
3759 (when (eq major-mode 'completion-list-mode)
3760 (toggle-read-only 1)))
3761
3762(add-hook 'temp-buffer-show-hook 'completion-list-mode-finish)
3763
747a0e2f
RS
3764(defvar completion-setup-hook nil
3765 "Normal hook run at the end of setting up a completion list buffer.
3766When this hook is run, the current buffer is the one in which the
3767command to display the completion list buffer was run.
3768The completion list buffer is available as the value of `standard-output'.")
3769
98b45886
RS
3770;; This function goes in completion-setup-hook, so that it is called
3771;; after the text of the completion list buffer is written.
6096f362 3772
e8a700bf
RS
3773(defun completion-setup-function ()
3774 (save-excursion
98b45886 3775 (let ((mainbuf (current-buffer)))
3819736b
RS
3776 (set-buffer standard-output)
3777 (completion-list-mode)
3778 (make-local-variable 'completion-reference-buffer)
3779 (setq completion-reference-buffer mainbuf)
50be475d
RS
3780 (if (eq minibuffer-completion-table 'read-file-name-internal)
3781 ;; For file name completion,
3782 ;; use the number of chars before the start of the
3783 ;; last file name component.
3784 (setq completion-base-size
3785 (save-excursion
3786 (set-buffer mainbuf)
3787 (goto-char (point-max))
3788 (skip-chars-backward (format "^%c" directory-sep-char))
0aad4805 3789 (- (point) (minibuffer-prompt-end))))
19183a29
RS
3790 ;; Otherwise, in minibuffer, the whole input is being completed.
3791 (save-match-data
3792 (if (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
3793 (buffer-name mainbuf))
3794 (setq completion-base-size 0))))
3819736b 3795 (goto-char (point-min))
0d6e23cf 3796 (if (display-mouse-p)
3819736b 3797 (insert (substitute-command-keys
80298193
RS
3798 "Click \\[mouse-choose-completion] on a completion to select it.\n")))
3799 (insert (substitute-command-keys
3800 "In this buffer, type \\[choose-completion] to \
7d22ed15 3801select the completion near point.\n\n")))))
c88ab9ce 3802
e8a700bf 3803(add-hook 'completion-setup-hook 'completion-setup-function)
dde69dbe
RS
3804
3805(define-key minibuffer-local-completion-map [prior]
3806 'switch-to-completions)
3807(define-key minibuffer-local-must-match-map [prior]
3808 'switch-to-completions)
3809(define-key minibuffer-local-completion-map "\M-v"
3810 'switch-to-completions)
3811(define-key minibuffer-local-must-match-map "\M-v"
3812 'switch-to-completions)
3813
3814(defun switch-to-completions ()
3815 "Select the completion list window."
3816 (interactive)
9595fbdb
RS
3817 ;; Make sure we have a completions window.
3818 (or (get-buffer-window "*Completions*")
3819 (minibuffer-completion-help))
fdbd7c4d
KH
3820 (let ((window (get-buffer-window "*Completions*")))
3821 (when window
3822 (select-window window)
3823 (goto-char (point-min))
3824 (search-forward "\n\n")
3825 (forward-line 1))))
eaae8106 3826
82072f33
RS
3827;; Support keyboard commands to turn on various modifiers.
3828
3829;; These functions -- which are not commands -- each add one modifier
3830;; to the following event.
3831
3832(defun event-apply-alt-modifier (ignore-prompt)
70cf9f08
KH
3833 "Add the Alt modifier to the following event.
3834For example, type \\[event-apply-alt-modifier] & to enter Alt-&."
82072f33
RS
3835 (vector (event-apply-modifier (read-event) 'alt 22 "A-")))
3836(defun event-apply-super-modifier (ignore-prompt)
70cf9f08
KH
3837 "Add the Super modifier to the following event.
3838For example, type \\[event-apply-super-modifier] & to enter Super-&."
82072f33
RS
3839 (vector (event-apply-modifier (read-event) 'super 23 "s-")))
3840(defun event-apply-hyper-modifier (ignore-prompt)
70cf9f08
KH
3841 "Add the Hyper modifier to the following event.
3842For example, type \\[event-apply-hyper-modifier] & to enter Hyper-&."
82072f33
RS
3843 (vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
3844(defun event-apply-shift-modifier (ignore-prompt)
70cf9f08
KH
3845 "Add the Shift modifier to the following event.
3846For example, type \\[event-apply-shift-modifier] & to enter Shift-&."
82072f33
RS
3847 (vector (event-apply-modifier (read-event) 'shift 25 "S-")))
3848(defun event-apply-control-modifier (ignore-prompt)
70cf9f08
KH
3849 "Add the Ctrl modifier to the following event.
3850For example, type \\[event-apply-control-modifier] & to enter Ctrl-&."
82072f33
RS
3851 (vector (event-apply-modifier (read-event) 'control 26 "C-")))
3852(defun event-apply-meta-modifier (ignore-prompt)
70cf9f08
KH
3853 "Add the Meta modifier to the following event.
3854For example, type \\[event-apply-meta-modifier] & to enter Meta-&."
82072f33
RS
3855 (vector (event-apply-modifier (read-event) 'meta 27 "M-")))
3856
3857(defun event-apply-modifier (event symbol lshiftby prefix)
3858 "Apply a modifier flag to event EVENT.
3859SYMBOL is the name of this modifier, as a symbol.
3860LSHIFTBY is the numeric value of this modifier, in keyboard events.
3861PREFIX is the string that represents this modifier in an event type symbol."
3862 (if (numberp event)
3863 (cond ((eq symbol 'control)
90bebcb0
KH
3864 (if (and (<= (downcase event) ?z)
3865 (>= (downcase event) ?a))
82072f33 3866 (- (downcase event) ?a -1)
90bebcb0
KH
3867 (if (and (<= (downcase event) ?Z)
3868 (>= (downcase event) ?A))
82072f33
RS
3869 (- (downcase event) ?A -1)
3870 (logior (lsh 1 lshiftby) event))))
3871 ((eq symbol 'shift)
3872 (if (and (<= (downcase event) ?z)
3873 (>= (downcase event) ?a))
3874 (upcase event)
3875 (logior (lsh 1 lshiftby) event)))
3876 (t
3877 (logior (lsh 1 lshiftby) event)))
3878 (if (memq symbol (event-modifiers event))
3879 event
3880 (let ((event-type (if (symbolp event) event (car event))))
3881 (setq event-type (intern (concat prefix (symbol-name event-type))))
3882 (if (symbolp event)
3883 event-type
3884 (cons event-type (cdr event)))))))
3885
e5fff738
KH
3886(define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier)
3887(define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier)
3888(define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier)
3889(define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier)
3890(define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier)
3891(define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier)
eaae8106 3892
a3d1480b
JB
3893;;;; Keypad support.
3894
3895;;; Make the keypad keys act like ordinary typing keys. If people add
3896;;; bindings for the function key symbols, then those bindings will
3897;;; override these, so this shouldn't interfere with any existing
3898;;; bindings.
3899
0d173134 3900;; Also tell read-char how to handle these keys.
e1e04350 3901(mapc
a3d1480b
JB
3902 (lambda (keypad-normal)
3903 (let ((keypad (nth 0 keypad-normal))
3904 (normal (nth 1 keypad-normal)))
0d173134 3905 (put keypad 'ascii-character normal)
a3d1480b
JB
3906 (define-key function-key-map (vector keypad) (vector normal))))
3907 '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
3908 (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
3909 (kp-space ?\ )
3910 (kp-tab ?\t)
3911 (kp-enter ?\r)
3912 (kp-multiply ?*)
3913 (kp-add ?+)
3914 (kp-separator ?,)
3915 (kp-subtract ?-)
3916 (kp-decimal ?.)
3917 (kp-divide ?/)
3918 (kp-equal ?=)))
3919
1e722f9f 3920;;;;
b005abd5 3921;;;; forking a twin copy of a buffer.
1e722f9f 3922;;;;
b005abd5
SM
3923
3924(defvar clone-buffer-hook nil
3925 "Normal hook to run in the new buffer at the end of `clone-buffer'.")
3926
3927(defun clone-process (process &optional newname)
3928 "Create a twin copy of PROCESS.
3929If NEWNAME is nil, it defaults to PROCESS' name;
3930NEWNAME is modified by adding or incrementing <N> at the end as necessary.
3931If PROCESS is associated with a buffer, the new process will be associated
3932 with the current buffer instead.
3933Returns nil if PROCESS has already terminated."
3934 (setq newname (or newname (process-name process)))
3935 (if (string-match "<[0-9]+>\\'" newname)
3936 (setq newname (substring newname 0 (match-beginning 0))))
3937 (when (memq (process-status process) '(run stop open))
3938 (let* ((process-connection-type (process-tty-name process))
b005abd5
SM
3939 (new-process
3940 (if (memq (process-status process) '(open))
ed7069af
KS
3941 (let ((args (process-contact process t)))
3942 (setq args (plist-put args :name newname))
3943 (setq args (plist-put args :buffer
3944 (if (process-buffer process) (current-buffer))))
3945 (apply 'make-network-process args))
b005abd5
SM
3946 (apply 'start-process newname
3947 (if (process-buffer process) (current-buffer))
3948 (process-command process)))))
ed7069af
KS
3949 (set-process-query-on-exit-flag
3950 new-process (process-query-on-exit-flag process))
b005abd5
SM
3951 (set-process-inherit-coding-system-flag
3952 new-process (process-inherit-coding-system-flag process))
3953 (set-process-filter new-process (process-filter process))
3954 (set-process-sentinel new-process (process-sentinel process))
3955 new-process)))
3956
b75b82ab 3957;; things to maybe add (currently partly covered by `funcall mode'):
b005abd5
SM
3958;; - syntax-table
3959;; - overlays
3960(defun clone-buffer (&optional newname display-flag)
3961 "Create a twin copy of the current buffer.
3962If NEWNAME is nil, it defaults to the current buffer's name;
3963NEWNAME is modified by adding or incrementing <N> at the end as necessary.
3964
3965If DISPLAY-FLAG is non-nil, the new buffer is shown with `pop-to-buffer'.
3966This runs the normal hook `clone-buffer-hook' in the new buffer
3967after it has been set up properly in other respects."
61acfe7f
RS
3968 (interactive
3969 (progn
3970 (if buffer-file-name
3971 (error "Cannot clone a file-visiting buffer"))
3972 (if (get major-mode 'no-clone)
3973 (error "Cannot clone a buffer in %s mode" mode-name))
3974 (list (if current-prefix-arg (read-string "Name: "))
3975 t)))
b005abd5
SM
3976 (if buffer-file-name
3977 (error "Cannot clone a file-visiting buffer"))
3978 (if (get major-mode 'no-clone)
3979 (error "Cannot clone a buffer in %s mode" mode-name))
3980 (setq newname (or newname (buffer-name)))
3981 (if (string-match "<[0-9]+>\\'" newname)
3982 (setq newname (substring newname 0 (match-beginning 0))))
3983 (let ((buf (current-buffer))
3984 (ptmin (point-min))
3985 (ptmax (point-max))
3986 (pt (point))
3987 (mk (if mark-active (mark t)))
3988 (modified (buffer-modified-p))
3989 (mode major-mode)
3990 (lvars (buffer-local-variables))
3991 (process (get-buffer-process (current-buffer)))
3992 (new (generate-new-buffer (or newname (buffer-name)))))
3993 (save-restriction
3994 (widen)
3995 (with-current-buffer new
3996 (insert-buffer-substring buf)))
3997 (with-current-buffer new
3998 (narrow-to-region ptmin ptmax)
3999 (goto-char pt)
4000 (if mk (set-mark mk))
4001 (set-buffer-modified-p modified)
4002
4003 ;; Clone the old buffer's process, if any.
4004 (when process (clone-process process))
4005
4006 ;; Now set up the major mode.
4007 (funcall mode)
4008
4009 ;; Set up other local variables.
4010 (mapcar (lambda (v)
4011 (condition-case () ;in case var is read-only
4012 (if (symbolp v)
4013 (makunbound v)
4014 (set (make-local-variable (car v)) (cdr v)))
4015 (error nil)))
4016 lvars)
4017
4018 ;; Run any hooks (typically set up by the major mode
4019 ;; for cloning to work properly).
4020 (run-hooks 'clone-buffer-hook))
4021 (if display-flag (pop-to-buffer new))
4022 new))
4023
fa65f20b 4024
7e3afb04 4025(defun clone-indirect-buffer (newname display-flag &optional norecord)
fa65f20b
GM
4026 "Create an indirect buffer that is a twin copy of the current buffer.
4027
4028Give the indirect buffer name NEWNAME. Interactively, read NEW-NAME
4029from the minibuffer when invoked with a prefix arg. If NEWNAME is nil
4030or if not called with a prefix arg, NEWNAME defaults to the current
4031buffer's name. The name is modified by adding a `<N>' suffix to it
4032or by incrementing the N in an existing suffix.
4033
4034DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'.
7e3afb04
GM
4035This is always done when called interactively.
4036
4037Optional last arg NORECORD non-nil means do not put this buffer at the
4038front of the list of recently selected ones."
61acfe7f
RS
4039 (interactive
4040 (progn
4041 (if (get major-mode 'no-clone-indirect)
4042 (error "Cannot indirectly clone a buffer in %s mode" mode-name))
4043 (list (if current-prefix-arg
4044 (read-string "BName of indirect buffer: "))
4045 t)))
4046 (if (get major-mode 'no-clone-indirect)
4047 (error "Cannot indirectly clone a buffer in %s mode" mode-name))
fa65f20b
GM
4048 (setq newname (or newname (buffer-name)))
4049 (if (string-match "<[0-9]+>\\'" newname)
4050 (setq newname (substring newname 0 (match-beginning 0))))
4051 (let* ((name (generate-new-buffer-name newname))
4052 (buffer (make-indirect-buffer (current-buffer) name t)))
4053 (when display-flag
58dd38f1 4054 (pop-to-buffer buffer norecord))
fa65f20b
GM
4055 buffer))
4056
4057
7e3afb04
GM
4058(defun clone-indirect-buffer-other-window (buffer &optional norecord)
4059 "Create an indirect buffer that is a twin copy of BUFFER.
4060Select the new buffer in another window.
4061Optional second arg NORECORD non-nil means do not put this buffer at
4062the front of the list of recently selected ones."
4063 (interactive "bClone buffer in other window: ")
4064 (let ((popup-windows t))
4065 (set-buffer buffer)
4066 (clone-indirect-buffer nil t norecord)))
4067
14583cb1 4068(define-key ctl-x-4-map "c" 'clone-indirect-buffer-other-window)
7e3afb04 4069
eaae8106 4070
1d4b11bf
GM
4071;;; Handling of Backspace and Delete keys.
4072
7f62656b
EZ
4073(defcustom normal-erase-is-backspace nil
4074 "If non-nil, Delete key deletes forward and Backspace key deletes backward.
1d4b11bf
GM
4075
4076On window systems, the default value of this option is chosen
4077according to the keyboard used. If the keyboard has both a Backspace
4078key and a Delete key, and both are mapped to their usual meanings, the
4079option's default value is set to t, so that Backspace can be used to
7f62656b 4080delete backward, and Delete can be used to delete forward.
1d4b11bf 4081
7f62656b 4082If not running under a window system, customizing this option accomplishes
1d4b11bf
GM
4083a similar effect by mapping C-h, which is usually generated by the
4084Backspace key, to DEL, and by mapping DEL to C-d via
4085`keyboard-translate'. The former functionality of C-h is available on
4086the F1 key. You should probably not use this setting if you don't
f060b834
GM
4087have both Backspace, Delete and F1 keys.
4088
4089Setting this variable with setq doesn't take effect. Programmatically,
7f62656b 4090call `normal-erase-is-backspace-mode' (which see) instead."
1d4b11bf
GM
4091 :type 'boolean
4092 :group 'editing-basics
4093 :version "21.1"
4094 :set (lambda (symbol value)
4095 ;; The fboundp is because of a problem with :set when
4096 ;; dumping Emacs. It doesn't really matter.
7f62656b
EZ
4097 (if (fboundp 'normal-erase-is-backspace-mode)
4098 (normal-erase-is-backspace-mode (or value 0))
1d4b11bf
GM
4099 (set-default symbol value))))
4100
4101
7f62656b
EZ
4102(defun normal-erase-is-backspace-mode (&optional arg)
4103 "Toggle the Erase and Delete mode of the Backspace and Delete keys.
4104
e02160a3 4105With numeric arg, turn the mode on if and only if ARG is positive.
7f62656b
EZ
4106
4107On window systems, when this mode is on, Delete is mapped to C-d and
4108Backspace is mapped to DEL; when this mode is off, both Delete and
4109Backspace are mapped to DEL. (The remapping goes via
4110`function-key-map', so binding Delete or Backspace in the global or
4111local keymap will override that.)
4112
4113In addition, on window systems, the bindings of C-Delete, M-Delete,
4114C-M-Delete, C-Backspace, M-Backspace, and C-M-Backspace are changed in
4115the global keymap in accordance with the functionality of Delete and
4116Backspace. For example, if Delete is remapped to C-d, which deletes
4117forward, C-Delete is bound to `kill-word', but if Delete is remapped
4118to DEL, which deletes backward, C-Delete is bound to
4119`backward-kill-word'.
4120
4121If not running on a window system, a similar effect is accomplished by
4122remapping C-h (normally produced by the Backspace key) and DEL via
4123`keyboard-translate': if this mode is on, C-h is mapped to DEL and DEL
4124to C-d; if it's off, the keys are not remapped.
4125
4126When not running on a window system, and this mode is turned on, the
4127former functionality of C-h is available on the F1 key. You should
4128probably not turn on this mode on a text-only terminal if you don't
4129have both Backspace, Delete and F1 keys.
4130
4131See also `normal-erase-is-backspace'."
1d4b11bf 4132 (interactive "P")
7f62656b 4133 (setq normal-erase-is-backspace
1d4b11bf
GM
4134 (if arg
4135 (> (prefix-numeric-value arg) 0)
7f62656b 4136 (not normal-erase-is-backspace)))
1d4b11bf 4137
13a9eed7
EZ
4138 (cond ((or (memq window-system '(x w32 mac pc))
4139 (memq system-type '(ms-dos windows-nt)))
7f62656b 4140 (let ((bindings
103db06c
RS
4141 `(([C-delete] [C-backspace])
4142 ([M-delete] [M-backspace])
4143 ([C-M-delete] [C-M-backspace])
ec9f4754 4144 (,esc-map
103db06c
RS
4145 [C-delete] [C-backspace])))
4146 (old-state (lookup-key function-key-map [delete])))
ec9f4754 4147
7f62656b 4148 (if normal-erase-is-backspace
ec9f4754
GM
4149 (progn
4150 (define-key function-key-map [delete] [?\C-d])
be4f1e41 4151 (define-key function-key-map [kp-delete] [?\C-d])
ec9f4754
GM
4152 (define-key function-key-map [backspace] [?\C-?]))
4153 (define-key function-key-map [delete] [?\C-?])
be4f1e41 4154 (define-key function-key-map [kp-delete] [?\C-?])
ec9f4754
GM
4155 (define-key function-key-map [backspace] [?\C-?]))
4156
103db06c
RS
4157 ;; Maybe swap bindings of C-delete and C-backspace, etc.
4158 (unless (equal old-state (lookup-key function-key-map [delete]))
4159 (dolist (binding bindings)
4160 (let ((map global-map))
4161 (when (keymapp (car binding))
4162 (setq map (car binding) binding (cdr binding)))
4163 (let* ((key1 (nth 0 binding))
4164 (key2 (nth 1 binding))
4165 (binding1 (lookup-key map key1))
4166 (binding2 (lookup-key map key2)))
4167 (define-key map key1 binding2)
4168 (define-key map key2 binding1)))))))
1d4b11bf 4169 (t
7f62656b 4170 (if normal-erase-is-backspace
1d4b11bf
GM
4171 (progn
4172 (keyboard-translate ?\C-h ?\C-?)
4173 (keyboard-translate ?\C-? ?\C-d))
4174 (keyboard-translate ?\C-h ?\C-h)
4175 (keyboard-translate ?\C-? ?\C-?))))
4176
7f62656b 4177 (run-hooks 'normal-erase-is-backspace-hook)
1d4b11bf 4178 (if (interactive-p)
7f62656b
EZ
4179 (message "Delete key deletes %s"
4180 (if normal-erase-is-backspace "forward" "backward"))))
4181
1d4b11bf 4182
ed7069af
KS
4183;;; make-network-process wrappers
4184
41ad6233 4185(if (featurep 'make-network-process)
ed7069af
KS
4186 (progn
4187
4188(defun open-network-stream (name buffer host service)
4189 "Open a TCP connection for a service to a host.
4190Returns a subprocess-object to represent the connection.
4191Input and output work as for subprocesses; `delete-process' closes it.
4192Args are NAME BUFFER HOST SERVICE.
4193NAME is name for process. It is modified if necessary to make it unique.
4194BUFFER is the buffer (or buffer-name) to associate with the process.
4195 Process output goes at end of that buffer, unless you specify
4196 an output stream or filter function to handle the output.
4197 BUFFER may be also nil, meaning that this process is not associated
4198 with any buffer
4199Third arg is name of the host to connect to, or its IP address.
4200Fourth arg SERVICE is name of the service desired, or an integer
4201specifying a port number to connect to."
4202 (make-network-process :name name :buffer buffer
4203 :host host :service service))
4204
4205(defun open-network-stream-nowait (name buffer host service &optional sentinel filter)
4206 "Initiate connection to a TCP connection for a service to a host.
4207It returns nil if non-blocking connects are not supported; otherwise,
4208it returns a subprocess-object to represent the connection.
4209
4210This function is similar to `open-network-stream', except that this
4211function returns before the connection is established. When the
4212connection is completed, the sentinel function will be called with
4213second arg matching `open' (if successful) or `failed' (on error).
4214
4215Args are NAME BUFFER HOST SERVICE SENTINEL FILTER.
4216NAME, BUFFER, HOST, and SERVICE are as for `open-network-stream'.
4217Optional args, SENTINEL and FILTER specifies the sentinel and filter
4218functions to be used for this network stream."
557ba8b2 4219 (if (featurep 'make-network-process '(:nowait t))
ed7069af
KS
4220 (make-network-process :name name :buffer buffer :nowait t
4221 :host host :service service
4222 :filter filter :sentinel sentinel)))
4223
4224(defun open-network-stream-server (name buffer service &optional sentinel filter)
4225 "Create a network server process for a TCP service.
4226It returns nil if server processes are not supported; otherwise,
4227it returns a subprocess-object to represent the server.
4228
4229When a client connects to the specified service, a new subprocess
4230is created to handle the new connection, and the sentinel function
4231is called for the new process.
4232
4233Args are NAME BUFFER SERVICE SENTINEL FILTER.
4234NAME is name for the server process. Client processes are named by
4235appending the ip-address and port number of the client to NAME.
4236BUFFER is the buffer (or buffer-name) to associate with the server
4237process. Client processes will not get a buffer if a process filter
4238is specified or BUFFER is nil; otherwise, a new buffer is created for
4239the client process. The name is similar to the process name.
4240Third arg SERVICE is name of the service desired, or an integer
4241specifying a port number to connect to. It may also be t to selected
4242an unused port number for the server.
4243Optional args, SENTINEL and FILTER specifies the sentinel and filter
4244functions to be used for the client processes; the server process
4245does not use these function."
557ba8b2 4246 (if (featurep 'make-network-process '(:server t))
ed7069af
KS
4247 (make-network-process :name name :buffer buffer
4248 :service service :server t :noquery t)))
4249
41ad6233 4250)) ;; (featurep 'make-network-process)
ed7069af
KS
4251
4252
4253;; compatibility
4254
4255(defun process-kill-without-query (process &optional flag)
4256 "Say no query needed if PROCESS is running when Emacs is exited.
4257Optional second argument if non-nil says to require a query.
4258Value is t if a query was formerly required.
4259New code should not use this function; use `process-query-on-exit-flag'
4260or `set-process-query-on-exit-flag' instead."
4261 (let ((old (process-query-on-exit-flag process)))
4262 (set-process-query-on-exit-flag process nil)
4263 old))
4264
9985d391
GM
4265;;; Misc
4266
4267(defun byte-compiling-files-p ()
4268 "Return t if currently byte-compiling files."
4269 (and (boundp 'byte-compile-current-file)
4270 (stringp byte-compile-current-file)))
eaae8106 4271
9b350152 4272
e1e04350 4273;; Minibuffer prompt stuff.
9b350152 4274
49c14a05
GM
4275;(defun minibuffer-prompt-modification (start end)
4276; (error "You cannot modify the prompt"))
4277;
4278;
4279;(defun minibuffer-prompt-insertion (start end)
4280; (let ((inhibit-modification-hooks t))
4281; (delete-region start end)
4282; ;; Discard undo information for the text insertion itself
4283; ;; and for the text deletion.above.
4284; (when (consp buffer-undo-list)
4285; (setq buffer-undo-list (cddr buffer-undo-list)))
4286; (message "You cannot modify the prompt")))
4287;
4288;
4289;(setq minibuffer-prompt-properties
4290; (list 'modification-hooks '(minibuffer-prompt-modification)
4291; 'insert-in-front-hooks '(minibuffer-prompt-insertion)))
4292;
9b350152 4293
c88ab9ce 4294;;; simple.el ends here