(isearch-done): Call deactivate-mark instead of setting mark-active
[bpt/emacs.git] / lisp / simple.el
CommitLineData
c88ab9ce
ER
1;;; simple.el --- basic editing commands for Emacs
2
a61099dd 3;; Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc.
2076c87c
JB
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
3a801d0c 9;; the Free Software Foundation; either version 2, or (at your option)
2076c87c
JB
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to
19;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
20
d9ecc911
ER
21;;; Commentary:
22
23;; A grab-bag of basic Emacs commands not specifically related to some
24;; major mode or to file-handling.
25
3a801d0c 26;;; Code:
2076c87c
JB
27
28(defun open-line (arg)
ff1fbe3e 29 "Insert a newline and leave point before it.
616ed245
RS
30If there is a fill prefix, insert the fill prefix on the new line
31if the line would have been empty.
32With arg N, insert N newlines."
2076c87c 33 (interactive "*p")
616ed245
RS
34 (let* ((do-fill-prefix (and fill-prefix (bolp)))
35 (flag (and (null do-fill-prefix) (bolp) (not (bobp)))))
62c48f87
RS
36 ;; If this is a simple case, and we are at the beginning of a line,
37 ;; actually insert the newline *before* the preceding newline
38 ;; instead of after. That makes better display behavior.
39 (if flag
40 (progn
41 ;; If undo is enabled, don't let this hack be visible:
42 ;; record the real value of point as the place to move back to
43 ;; if we undo this insert.
44 (if (and buffer-undo-list (not (eq buffer-undo-list t)))
45 (setq buffer-undo-list (cons (point) buffer-undo-list)))
46 (forward-char -1)))
2076c87c
JB
47 (while (> arg 0)
48 (save-excursion
616ed245
RS
49 (insert ?\n))
50 (if do-fill-prefix (insert fill-prefix))
2076c87c
JB
51 (setq arg (1- arg)))
52 (if flag (forward-char 1))))
53
54(defun split-line ()
55 "Split current line, moving portion beyond point vertically down."
56 (interactive "*")
57 (skip-chars-forward " \t")
58 (let ((col (current-column))
59 (pos (point)))
60 (insert ?\n)
61 (indent-to col 0)
62 (goto-char pos)))
63
64(defun quoted-insert (arg)
65 "Read next input character and insert it.
ff1fbe3e 66This is useful for inserting control characters.
dbc4e1c1 67You may also type up to 3 octal digits, to insert a character with that code.
b6a22db0
JB
68
69In overwrite mode, this function inserts the character anyway, and
70does not handle octal digits specially. This means that if you use
71overwrite as your normal editing mode, you can use this function to
72insert characters when necessary.
73
74In binary overwrite mode, this function does overwrite, and octal
75digits are interpreted as a character code. This is supposed to make
76this function useful in editing binary files."
2076c87c 77 (interactive "*p")
b6a22db0
JB
78 (let ((char (if (or (not overwrite-mode)
79 (eq overwrite-mode 'overwrite-mode-binary))
80 (read-quoted-char)
81 (read-char))))
82 (if (eq overwrite-mode 'overwrite-mode-binary)
83 (delete-char arg))
1537a263 84 (insert-char char arg)))
2076c87c
JB
85
86(defun delete-indentation (&optional arg)
87 "Join this line to previous and fix up whitespace at join.
ccc58657 88If there is a fill prefix, delete it from the beginning of this line.
2076c87c
JB
89With argument, join this line to following line."
90 (interactive "*P")
91 (beginning-of-line)
92 (if arg (forward-line 1))
93 (if (eq (preceding-char) ?\n)
94 (progn
95 (delete-region (point) (1- (point)))
ccc58657
RS
96 ;; If the second line started with the fill prefix,
97 ;; delete the prefix.
98 (if (and fill-prefix
01b8e020 99 (<= (+ (point) (length fill-prefix)) (point-max))
ccc58657
RS
100 (string= fill-prefix
101 (buffer-substring (point)
102 (+ (point) (length fill-prefix)))))
103 (delete-region (point) (+ (point) (length fill-prefix))))
2076c87c
JB
104 (fixup-whitespace))))
105
106(defun fixup-whitespace ()
107 "Fixup white space between objects around point.
108Leave one space or none, according to the context."
109 (interactive "*")
110 (save-excursion
111 (delete-horizontal-space)
112 (if (or (looking-at "^\\|\\s)")
113 (save-excursion (forward-char -1)
114 (looking-at "$\\|\\s(\\|\\s'")))
115 nil
116 (insert ?\ ))))
117
118(defun delete-horizontal-space ()
119 "Delete all spaces and tabs around point."
120 (interactive "*")
121 (skip-chars-backward " \t")
122 (delete-region (point) (progn (skip-chars-forward " \t") (point))))
123
124(defun just-one-space ()
125 "Delete all spaces and tabs around point, leaving one space."
126 (interactive "*")
127 (skip-chars-backward " \t")
128 (if (= (following-char) ? )
129 (forward-char 1)
130 (insert ? ))
131 (delete-region (point) (progn (skip-chars-forward " \t") (point))))
132
133(defun delete-blank-lines ()
134 "On blank line, delete all surrounding blank lines, leaving just one.
135On isolated blank line, delete that one.
136On nonblank line, delete all blank lines that follow it."
137 (interactive "*")
138 (let (thisblank singleblank)
139 (save-excursion
140 (beginning-of-line)
141 (setq thisblank (looking-at "[ \t]*$"))
70e14c01 142 ;; Set singleblank if there is just one blank line here.
2076c87c
JB
143 (setq singleblank
144 (and thisblank
145 (not (looking-at "[ \t]*\n[ \t]*$"))
146 (or (bobp)
147 (progn (forward-line -1)
148 (not (looking-at "[ \t]*$")))))))
70e14c01 149 ;; Delete preceding blank lines, and this one too if it's the only one.
2076c87c
JB
150 (if thisblank
151 (progn
152 (beginning-of-line)
153 (if singleblank (forward-line 1))
154 (delete-region (point)
155 (if (re-search-backward "[^ \t\n]" nil t)
156 (progn (forward-line 1) (point))
157 (point-min)))))
70e14c01
JB
158 ;; Delete following blank lines, unless the current line is blank
159 ;; and there are no following blank lines.
2076c87c
JB
160 (if (not (and thisblank singleblank))
161 (save-excursion
162 (end-of-line)
163 (forward-line 1)
164 (delete-region (point)
165 (if (re-search-forward "[^ \t\n]" nil t)
166 (progn (beginning-of-line) (point))
70e14c01
JB
167 (point-max)))))
168 ;; Handle the special case where point is followed by newline and eob.
169 ;; Delete the line, leaving point at eob.
170 (if (looking-at "^[ \t]*\n\\'")
171 (delete-region (point) (point-max)))))
2076c87c
JB
172
173(defun back-to-indentation ()
174 "Move point to the first non-whitespace character on this line."
175 (interactive)
176 (beginning-of-line 1)
177 (skip-chars-forward " \t"))
178
179(defun newline-and-indent ()
180 "Insert a newline, then indent according to major mode.
ff1fbe3e 181Indentation is done using the value of `indent-line-function'.
2076c87c 182In programming language modes, this is the same as TAB.
ff1fbe3e
RS
183In some text modes, where TAB inserts a tab, this command indents to the
184column specified by the variable `left-margin'."
2076c87c
JB
185 (interactive "*")
186 (delete-region (point) (progn (skip-chars-backward " \t") (point)))
46947372 187 (newline)
2076c87c
JB
188 (indent-according-to-mode))
189
190(defun reindent-then-newline-and-indent ()
191 "Reindent current line, insert newline, then indent the new line.
192Indentation of both lines is done according to the current major mode,
ff1fbe3e 193which means calling the current value of `indent-line-function'.
2076c87c
JB
194In programming language modes, this is the same as TAB.
195In some text modes, where TAB inserts a tab, this indents to the
ff1fbe3e 196column specified by the variable `left-margin'."
2076c87c
JB
197 (interactive "*")
198 (save-excursion
199 (delete-region (point) (progn (skip-chars-backward " \t") (point)))
200 (indent-according-to-mode))
46947372 201 (newline)
2076c87c
JB
202 (indent-according-to-mode))
203
dff7d67f
RS
204;; Internal subroutine of delete-char
205(defun kill-forward-chars (arg)
206 (if (listp arg) (setq arg (car arg)))
207 (if (eq arg '-) (setq arg -1))
208 (kill-region (point) (+ (point) arg)))
209
210;; Internal subroutine of backward-delete-char
211(defun kill-backward-chars (arg)
212 (if (listp arg) (setq arg (car arg)))
213 (if (eq arg '-) (setq arg -1))
214 (kill-region (point) (- (point) arg)))
215
2076c87c
JB
216(defun backward-delete-char-untabify (arg &optional killp)
217 "Delete characters backward, changing tabs into spaces.
218Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
219Interactively, ARG is the prefix arg (default 1)
220and KILLP is t if prefix arg is was specified."
221 (interactive "*p\nP")
222 (let ((count arg))
223 (save-excursion
224 (while (and (> count 0) (not (bobp)))
225 (if (= (preceding-char) ?\t)
226 (let ((col (current-column)))
227 (forward-char -1)
228 (setq col (- col (current-column)))
229 (insert-char ?\ col)
230 (delete-char 1)))
231 (forward-char -1)
232 (setq count (1- count)))))
233 (delete-backward-char arg killp)
234 ;; In overwrite mode, back over columns while clearing them out,
235 ;; unless at end of line.
236 (and overwrite-mode (not (eolp))
237 (save-excursion (insert-char ?\ arg))))
238
239(defun zap-to-char (arg char)
240 "Kill up to and including ARG'th occurrence of CHAR.
241Goes backward if ARG is negative; error if CHAR not found."
242 (interactive "p\ncZap to char: ")
243 (kill-region (point) (progn
244 (search-forward (char-to-string char) nil nil arg)
245; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
246 (point))))
247
248(defun beginning-of-buffer (&optional arg)
249 "Move point to the beginning of the buffer; leave mark at previous position.
250With arg N, put point N/10 of the way from the true beginning.
ff1fbe3e
RS
251
252Don't use this command in Lisp programs!
2076c87c
JB
253\(goto-char (point-min)) is faster and avoids clobbering the mark."
254 (interactive "P")
255 (push-mark)
256 (goto-char (if arg
257 (if (> (buffer-size) 10000)
258 ;; Avoid overflow for large buffer sizes!
259 (* (prefix-numeric-value arg)
260 (/ (buffer-size) 10))
261 (/ (+ 10 (* (buffer-size) (prefix-numeric-value arg))) 10))
262 (point-min)))
263 (if arg (forward-line 1)))
264
265(defun end-of-buffer (&optional arg)
266 "Move point to the end of the buffer; leave mark at previous position.
267With arg N, put point N/10 of the way from the true end.
ff1fbe3e
RS
268
269Don't use this command in Lisp programs!
2076c87c
JB
270\(goto-char (point-max)) is faster and avoids clobbering the mark."
271 (interactive "P")
272 (push-mark)
273 (goto-char (if arg
274 (- (1+ (buffer-size))
275 (if (> (buffer-size) 10000)
276 ;; Avoid overflow for large buffer sizes!
277 (* (prefix-numeric-value arg)
278 (/ (buffer-size) 10))
279 (/ (* (buffer-size) (prefix-numeric-value arg)) 10)))
280 (point-max)))
3a801d0c
ER
281 ;; If we went to a place in the middle of the buffer,
282 ;; adjust it to the beginning of a line.
2076c87c 283 (if arg (forward-line 1)
3a801d0c
ER
284 ;; If the end of the buffer is not already on the screen,
285 ;; then scroll specially to put it near, but not at, the bottom.
286 (if (let ((old-point (point)))
287 (save-excursion
288 (goto-char (window-start))
289 (vertical-motion (window-height))
290 (< (point) old-point)))
291 (recenter -3))))
2076c87c
JB
292
293(defun mark-whole-buffer ()
70e14c01
JB
294 "Put point at beginning and mark at end of buffer.
295You probably should not use this function in Lisp programs;
296it is usually a mistake for a Lisp function to use any subroutine
297that uses or sets the mark."
2076c87c
JB
298 (interactive)
299 (push-mark (point))
fd0f4056 300 (push-mark (point-max) nil t)
2076c87c
JB
301 (goto-char (point-min)))
302
303(defun count-lines-region (start end)
eb8c3be9 304 "Print number of lines and characters in the region."
2076c87c
JB
305 (interactive "r")
306 (message "Region has %d lines, %d characters"
307 (count-lines start end) (- end start)))
308
309(defun what-line ()
310 "Print the current line number (in the buffer) of point."
311 (interactive)
312 (save-restriction
313 (widen)
314 (save-excursion
315 (beginning-of-line)
316 (message "Line %d"
317 (1+ (count-lines 1 (point)))))))
318
319(defun count-lines (start end)
320 "Return number of lines between START and END.
321This is usually the number of newlines between them,
ff1fbe3e 322but can be one more if START is not equal to END
2076c87c 323and the greater of them is not at the start of a line."
dde92ca6
RS
324 (save-match-data
325 (save-excursion
326 (save-restriction
327 (narrow-to-region start end)
328 (goto-char (point-min))
329 (if (eq selective-display t)
330 (let ((done 0))
331 (while (re-search-forward "[\n\C-m]" nil t 40)
332 (setq done (+ 40 done)))
333 (while (re-search-forward "[\n\C-m]" nil t 1)
334 (setq done (+ 1 done)))
335 done)
336 (- (buffer-size) (forward-line (buffer-size))))))))
2076c87c
JB
337
338(defun what-cursor-position ()
339 "Print info on cursor position (on screen and within buffer)."
340 (interactive)
341 (let* ((char (following-char))
342 (beg (point-min))
343 (end (point-max))
344 (pos (point))
345 (total (buffer-size))
346 (percent (if (> total 50000)
347 ;; Avoid overflow from multiplying by 100!
348 (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
349 (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
350 (hscroll (if (= (window-hscroll) 0)
351 ""
352 (format " Hscroll=%d" (window-hscroll))))
353 (col (current-column)))
354 (if (= pos end)
355 (if (or (/= beg 1) (/= end (1+ total)))
356 (message "point=%d of %d(%d%%) <%d - %d> column %d %s"
357 pos total percent beg end col hscroll)
358 (message "point=%d of %d(%d%%) column %d %s"
359 pos total percent col hscroll))
360 (if (or (/= beg 1) (/= end (1+ total)))
361 (message "Char: %s (0%o) point=%d of %d(%d%%) <%d - %d> column %d %s"
362 (single-key-description char) char pos total percent beg end col hscroll)
363 (message "Char: %s (0%o) point=%d of %d(%d%%) column %d %s"
364 (single-key-description char) char pos total percent col hscroll)))))
365
366(defun fundamental-mode ()
367 "Major mode not specialized for anything in particular.
368Other major modes are defined by comparison with this one."
369 (interactive)
370 (kill-all-local-variables))
371
854c16c5
RS
372(defvar read-expression-map (copy-keymap minibuffer-local-map)
373 "Minibuffer keymap used for reading Lisp expressions.")
374(define-key read-expression-map "\M-\t" 'lisp-complete-symbol)
375
2076c87c
JB
376(put 'eval-expression 'disabled t)
377
378;; We define this, rather than making eval interactive,
379;; for the sake of completion of names like eval-region, eval-current-buffer.
380(defun eval-expression (expression)
381 "Evaluate EXPRESSION and print value in minibuffer.
eb57c304 382Value is also consed on to front of the variable `values'."
854c16c5
RS
383 (interactive (list (read-from-minibuffer "Eval: "
384 nil read-expression-map t)))
2076c87c
JB
385 (setq values (cons (eval expression) values))
386 (prin1 (car values) t))
387
388(defun edit-and-eval-command (prompt command)
389 "Prompting with PROMPT, let user edit COMMAND and eval result.
390COMMAND is a Lisp expression. Let user edit that expression in
391the minibuffer, then read and evaluate the result."
854c16c5
RS
392 (let ((command (read-from-minibuffer prompt
393 (prin1-to-string command)
394 read-expression-map t)))
2076c87c
JB
395 ;; Add edited command to command history, unless redundant.
396 (or (equal command (car command-history))
397 (setq command-history (cons command command-history)))
398 (eval command)))
399
ebb61177 400(defun repeat-complex-command (arg)
2076c87c
JB
401 "Edit and re-evaluate last complex command, or ARGth from last.
402A complex command is one which used the minibuffer.
403The command is placed in the minibuffer as a Lisp form for editing.
404The result is executed, repeating the command as changed.
405If the command has been changed or is not the most recent previous command
406it is added to the front of the command history.
eb6e9899
RS
407You can use the minibuffer history commands \\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
408to get different commands to edit and resubmit."
2076c87c 409 (interactive "p")
ba343182 410 (let ((elt (nth (1- arg) command-history))
ebb61177 411 (minibuffer-history-position arg)
ba343182 412 (minibuffer-history-sexp-flag t)
2076c87c
JB
413 newcmd)
414 (if elt
854c16c5 415 (progn
2076c87c
JB
416 (setq newcmd (read-from-minibuffer "Redo: "
417 (prin1-to-string elt)
854c16c5 418 read-expression-map
770970cb
RS
419 t
420 (cons 'command-history
421 arg)))
854c16c5
RS
422 ;; If command was added to command-history as a string,
423 ;; get rid of that. We want only evallable expressions there.
424 (if (stringp (car command-history))
425 (setq command-history (cdr command-history)))
2076c87c
JB
426 ;; If command to be redone does not match front of history,
427 ;; add it to the history.
428 (or (equal newcmd (car command-history))
429 (setq command-history (cons newcmd command-history)))
430 (eval newcmd))
431 (ding))))
e91f80c4 432\f
854c16c5
RS
433(defvar minibuffer-history nil
434 "Default minibuffer history list.
435This is used for all minibuffer input
436except when an alternate history list is specified.")
437(defvar minibuffer-history-sexp-flag nil
438 "Nonzero when doing history operations on `command-history'.
439More generally, indicates that the history list being acted on
440contains expressions rather than strings.")
e91f80c4
RS
441(setq minibuffer-history-variable 'minibuffer-history)
442(setq minibuffer-history-position nil)
854c16c5 443(defvar minibuffer-history-search-history nil)
e91f80c4 444
29929437 445(mapcar
d0678801
RM
446 (lambda (key-and-command)
447 (mapcar
448 (lambda (keymap-and-completionp)
449 ;; Arg is (KEYMAP-SYMBOL . COMPLETION-MAP-P).
450 ;; If the cdr of KEY-AND-COMMAND (the command) is a cons,
451 ;; its car is used if COMPLETION-MAP-P is nil, its cdr if it is t.
452 (define-key (symbol-value (car keymap-and-completionp))
453 (car key-and-command)
454 (let ((command (cdr key-and-command)))
455 (if (consp command)
b5e6f936
RM
456 ;; (and ... nil) => ... turns back on the completion-oriented
457 ;; history commands which rms turned off since they seem to
458 ;; do things he doesn't like.
459 (if (and (cdr keymap-and-completionp) nil) ;XXX turned off
d81362b0 460 (progn (error "EMACS BUG!") (cdr command))
d0678801
RM
461 (car command))
462 command))))
463 '((minibuffer-local-map . nil)
464 (minibuffer-local-ns-map . nil)
465 (minibuffer-local-completion-map . t)
466 (minibuffer-local-must-match-map . t)
467 (read-expression-map . nil))))
d81362b0
RM
468 '(("\en" . (next-history-element . next-complete-history-element))
469 ([next] . (next-history-element . next-complete-history-element))
470 ("\ep" . (previous-history-element . previous-complete-history-element))
471 ([prior] . (previous-history-element . previous-complete-history-element))
29929437
JB
472 ("\er" . previous-matching-history-element)
473 ("\es" . next-matching-history-element)))
e91f80c4 474
e91f80c4 475(defun previous-matching-history-element (regexp n)
854c16c5
RS
476 "Find the previous history element that matches REGEXP.
477\(Previous history elements refer to earlier actions.)
478With prefix argument N, search for Nth previous match.
479If N is negative, find the next or Nth next match."
480 (interactive
c1172a19
RS
481 (let* ((enable-recursive-minibuffers t)
482 (minibuffer-history-sexp-flag nil)
483 (regexp (read-from-minibuffer "Previous element matching (regexp): "
484 nil
485 minibuffer-local-map
486 nil
487 'minibuffer-history-search-history)))
488 ;; Use the last regexp specified, by default, if input is empty.
489 (list (if (string= regexp "")
490 (setcar minibuffer-history-search-history
491 (nth 1 minibuffer-history-search-history))
492 regexp)
854c16c5 493 (prefix-numeric-value current-prefix-arg))))
e91f80c4 494 (let ((history (symbol-value minibuffer-history-variable))
ccc58657 495 prevpos
e91f80c4
RS
496 (pos minibuffer-history-position))
497 (while (/= n 0)
498 (setq prevpos pos)
499 (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
500 (if (= pos prevpos)
501 (error (if (= pos 1)
ccc58657
RS
502 "No later matching history item"
503 "No earlier matching history item")))
e91f80c4
RS
504 (if (string-match regexp
505 (if minibuffer-history-sexp-flag
506 (prin1-to-string (nth (1- pos) history))
507 (nth (1- pos) history)))
854c16c5 508 (setq n (+ n (if (< n 0) 1 -1)))))
e91f80c4
RS
509 (setq minibuffer-history-position pos)
510 (erase-buffer)
511 (let ((elt (nth (1- pos) history)))
512 (insert (if minibuffer-history-sexp-flag
513 (prin1-to-string elt)
514 elt)))
854c16c5
RS
515 (goto-char (point-min)))
516 (if (or (eq (car (car command-history)) 'previous-matching-history-element)
517 (eq (car (car command-history)) 'next-matching-history-element))
518 (setq command-history (cdr command-history))))
e91f80c4 519
e91f80c4 520(defun next-matching-history-element (regexp n)
854c16c5
RS
521 "Find the next history element that matches REGEXP.
522\(The next history element refers to a more recent action.)
523With prefix argument N, search for Nth next match.
524If N is negative, find the previous or Nth previous match."
525 (interactive
c1172a19
RS
526 (let* ((enable-recursive-minibuffers t)
527 (minibuffer-history-sexp-flag nil)
528 (regexp (read-from-minibuffer "Next element matching (regexp): "
529 nil
530 minibuffer-local-map
531 nil
532 'minibuffer-history-search-history)))
533 ;; Use the last regexp specified, by default, if input is empty.
534 (list (if (string= regexp "")
535 (setcar minibuffer-history-search-history
536 (nth 1 minibuffer-history-search-history))
537 regexp)
854c16c5 538 (prefix-numeric-value current-prefix-arg))))
e91f80c4 539 (previous-matching-history-element regexp (- n)))
2076c87c 540
ebb61177
RS
541(defun next-history-element (n)
542 "Insert the next element of the minibuffer history into the minibuffer."
2076c87c 543 (interactive "p")
ebb61177
RS
544 (let ((narg (min (max 1 (- minibuffer-history-position n))
545 (length (symbol-value minibuffer-history-variable)))))
546 (if (= minibuffer-history-position narg)
547 (error (if (= minibuffer-history-position 1)
ccc58657
RS
548 "End of history; no next item"
549 "Beginning of history; no preceding item"))
2076c87c 550 (erase-buffer)
ebb61177 551 (setq minibuffer-history-position narg)
ba343182
RS
552 (let ((elt (nth (1- minibuffer-history-position)
553 (symbol-value minibuffer-history-variable))))
554 (insert
555 (if minibuffer-history-sexp-flag
556 (prin1-to-string elt)
770970cb 557 elt)))
2076c87c
JB
558 (goto-char (point-min)))))
559
ebb61177 560(defun previous-history-element (n)
3ee3a076 561 "Inserts the previous element of the minibuffer history into the minibuffer."
2076c87c 562 (interactive "p")
2c5e21c1 563 (next-history-element (- n)))
d0678801
RM
564
565(defun next-complete-history-element (n)
566 "\
567Get previous element of history which is a completion of minibuffer contents."
568 (interactive "p")
b5e6f936
RM
569 (let ((point-at-start (point)))
570 (next-matching-history-element
571 (concat "^" (regexp-quote (buffer-substring (point-min) (point)))) n)
572 ;; next-matching-history-element always puts us at (point-min).
573 ;; Move to the position we were at before changing the buffer contents.
574 ;; This is still sensical, because the text before point has not changed.
575 (goto-char point-at-start)))
d0678801
RM
576
577(defun previous-complete-history-element (n)
578 "Get next element of history which is a completion of minibuffer contents."
579 (interactive "p")
580 (next-complete-history-element (- n)))
e91f80c4 581\f
2076c87c
JB
582(defun goto-line (arg)
583 "Goto line ARG, counting from line 1 at beginning of buffer."
584 (interactive "NGoto line: ")
585 (save-restriction
586 (widen)
587 (goto-char 1)
588 (if (eq selective-display t)
589 (re-search-forward "[\n\C-m]" nil 'end (1- arg))
590 (forward-line (1- arg)))))
591
592;Put this on C-x u, so we can force that rather than C-_ into startup msg
dff7d67f 593(define-function 'advertised-undo 'undo)
2076c87c
JB
594
595(defun undo (&optional arg)
596 "Undo some previous changes.
597Repeat this command to undo more changes.
598A numeric argument serves as a repeat count."
599 (interactive "*p")
b553cffa
RS
600 (let ((modified (buffer-modified-p))
601 (recent-save (recent-auto-save-p)))
71e40adf
JB
602 (or (eq (selected-window) (minibuffer-window))
603 (message "Undo!"))
2076c87c
JB
604 (or (eq last-command 'undo)
605 (progn (undo-start)
606 (undo-more 1)))
607 (setq this-command 'undo)
608 (undo-more (or arg 1))
609 (and modified (not (buffer-modified-p))
b553cffa 610 (delete-auto-save-file-if-necessary recent-save))))
2076c87c 611
278b0a58
RS
612(defvar pending-undo-list nil
613 "Within a run of consecutive undo commands, list remaining to be undone.")
614
2076c87c 615(defun undo-start ()
ff1fbe3e
RS
616 "Set `pending-undo-list' to the front of the undo list.
617The next call to `undo-more' will undo the most recently made change."
2076c87c
JB
618 (if (eq buffer-undo-list t)
619 (error "No undo information in this buffer"))
620 (setq pending-undo-list buffer-undo-list))
621
622(defun undo-more (count)
623 "Undo back N undo-boundaries beyond what was already undone recently.
ff1fbe3e
RS
624Call `undo-start' to get ready to undo recent changes,
625then call `undo-more' one or more times to undo them."
2076c87c
JB
626 (or pending-undo-list
627 (error "No further undo information"))
628 (setq pending-undo-list (primitive-undo count pending-undo-list)))
629
630(defvar last-shell-command "")
631(defvar last-shell-command-on-region "")
632
633(defun shell-command (command &optional flag)
634 "Execute string COMMAND in inferior shell; display output, if any.
635If COMMAND ends in ampersand, execute it asynchronously.
636
637Optional second arg non-nil (prefix arg, if interactive)
638means insert output in current buffer after point (leave mark after it).
639This cannot be done asynchronously."
640 (interactive (list (read-string "Shell command: " last-shell-command)
641 current-prefix-arg))
642 (if flag
643 (progn (barf-if-buffer-read-only)
644 (push-mark)
645 ;; We do not use -f for csh; we will not support broken use of
646 ;; .cshrcs. Even the BSD csh manual says to use
647 ;; "if ($?prompt) exit" before things which are not useful
648 ;; non-interactively. Besides, if someone wants their other
649 ;; aliases for shell commands then they can still have them.
650 (call-process shell-file-name nil t nil
651 "-c" command)
c3e46f0c
RS
652 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
653 ;; It is cleaner to avoid activation, even though the command
654 ;; loop would deactivate the mark because we inserted text.
655 (goto-char (prog1 (mark t)
656 (set-marker (mark-marker) (point)
657 (current-buffer)))))
2076c87c
JB
658 ;; Preserve the match data in case called from a program.
659 (let ((data (match-data)))
660 (unwind-protect
661 (if (string-match "[ \t]*&[ \t]*$" command)
662 ;; Command ending with ampersand means asynchronous.
663 (let ((buffer (get-buffer-create "*shell-command*"))
664 (directory default-directory)
665 proc)
666 ;; Remove the ampersand.
667 (setq command (substring command 0 (match-beginning 0)))
668 ;; If will kill a process, query first.
669 (setq proc (get-buffer-process buffer))
670 (if proc
671 (if (yes-or-no-p "A command is running. Kill it? ")
672 (kill-process proc)
673 (error "Shell command in progress")))
674 (save-excursion
675 (set-buffer buffer)
676 (erase-buffer)
677 (display-buffer buffer)
678 (setq default-directory directory)
679 (setq proc (start-process "Shell" buffer
680 shell-file-name "-c" command))
681 (setq mode-line-process '(": %s"))
682 (set-process-sentinel proc 'shell-command-sentinel)
683 (set-process-filter proc 'shell-command-filter)
684 ))
685 (shell-command-on-region (point) (point) command nil))
686 (store-match-data data)))))
687
688;; We have a sentinel to prevent insertion of a termination message
689;; in the buffer itself.
690(defun shell-command-sentinel (process signal)
691 (if (memq (process-status process) '(exit signal))
692 (progn
693 (message "%s: %s."
694 (car (cdr (cdr (process-command process))))
695 (substring signal 0 -1))
696 (save-excursion
697 (set-buffer (process-buffer process))
698 (setq mode-line-process nil))
699 (delete-process process))))
700
701(defun shell-command-filter (proc string)
702 ;; Do save-excursion by hand so that we can leave point numerically unchanged
703 ;; despite an insertion immediately after it.
704 (let* ((obuf (current-buffer))
705 (buffer (process-buffer proc))
706 opoint
707 (window (get-buffer-window buffer))
708 (pos (window-start window)))
709 (unwind-protect
710 (progn
711 (set-buffer buffer)
712 (setq opoint (point))
713 (goto-char (point-max))
714 (insert-before-markers string))
715 ;; insert-before-markers moved this marker: set it back.
716 (set-window-start window pos)
717 ;; Finish our save-excursion.
718 (goto-char opoint)
719 (set-buffer obuf))))
720
721(defun shell-command-on-region (start end command &optional flag interactive)
722 "Execute string COMMAND in inferior shell with region as input.
723Normally display output (if any) in temp buffer `*Shell Command Output*';
724Prefix arg means replace the region with it.
725Noninteractive args are START, END, COMMAND, FLAG.
726Noninteractively FLAG means insert output in place of text from START to END,
727and put point at the end, but don't alter the mark.
728
729If the output is one line, it is displayed in the echo area,
730but it is nonetheless available in buffer `*Shell Command Output*'
731even though that buffer is not automatically displayed. If there is no output
732or output is inserted in the current buffer then `*Shell Command Output*' is
733deleted."
082c7686 734 (interactive (list (region-beginning) (region-end)
2076c87c
JB
735 (read-string "Shell command on region: "
736 last-shell-command-on-region)
737 current-prefix-arg
738 (prefix-numeric-value current-prefix-arg)))
739 (if flag
740 ;; Replace specified region with output from command.
741 (let ((swap (and interactive (< (point) (mark)))))
742 ;; Don't muck with mark
743 ;; unless called interactively.
744 (and interactive (push-mark))
745 (call-process-region start end shell-file-name t t nil
746 "-c" command)
747 (if (get-buffer "*Shell Command Output*")
748 (kill-buffer "*Shell Command Output*"))
749 (and interactive swap (exchange-point-and-mark)))
750 ;; No prefix argument: put the output in a temp buffer,
751 ;; replacing its entire contents.
752 (let ((buffer (get-buffer-create "*Shell Command Output*")))
753 (if (eq buffer (current-buffer))
754 ;; If the input is the same buffer as the output,
755 ;; delete everything but the specified region,
756 ;; then replace that region with the output.
757 (progn (delete-region end (point-max))
758 (delete-region (point-min) start)
759 (call-process-region (point-min) (point-max)
760 shell-file-name t t nil
761 "-c" command))
762 ;; Clear the output buffer, then run the command with output there.
763 (save-excursion
764 (set-buffer buffer)
765 (erase-buffer))
766 (call-process-region start end shell-file-name
767 nil buffer nil
768 "-c" command))
769 ;; Report the amount of output.
770 (let ((lines (save-excursion
771 (set-buffer buffer)
772 (if (= (buffer-size) 0)
773 0
774 (count-lines (point-min) (point-max))))))
775 (cond ((= lines 0)
776 (message "(Shell command completed with no output)")
777 (kill-buffer "*Shell Command Output*"))
778 ((= lines 1)
779 (message "%s"
780 (save-excursion
781 (set-buffer buffer)
782 (goto-char (point-min))
783 (buffer-substring (point)
784 (progn (end-of-line) (point))))))
785 (t
786 (set-window-start (display-buffer buffer) 1)))))))
787\f
788(defun universal-argument ()
789 "Begin a numeric argument for the following command.
790Digits or minus sign following \\[universal-argument] make up the numeric argument.
791\\[universal-argument] following the digits or minus sign ends the argument.
792\\[universal-argument] without digits or minus sign provides 4 as argument.
793Repeating \\[universal-argument] without digits or minus sign
794 multiplies the argument by 4 each time."
795 (interactive nil)
c637ae6f
JB
796 (let ((factor 4)
797 key)
70e14c01
JB
798;; (describe-arg (list factor) 1)
799 (setq key (read-key-sequence nil t))
c637ae6f
JB
800 (while (equal (key-binding key) 'universal-argument)
801 (setq factor (* 4 factor))
70e14c01
JB
802;; (describe-arg (list factor) 1)
803 (setq key (read-key-sequence nil t)))
c637ae6f
JB
804 (prefix-arg-internal key factor nil)))
805
806(defun prefix-arg-internal (key factor value)
2076c87c
JB
807 (let ((sign 1))
808 (if (and (numberp value) (< value 0))
809 (setq sign -1 value (- value)))
810 (if (eq value '-)
811 (setq sign -1 value nil))
70e14c01 812;; (describe-arg value sign)
c637ae6f
JB
813 (while (equal key "-")
814 (setq sign (- sign) factor nil)
70e14c01
JB
815;; (describe-arg value sign)
816 (setq key (read-key-sequence nil t)))
bd307392
JB
817 (while (and (stringp key)
818 (= (length key) 1)
c637ae6f
JB
819 (not (string< key "0"))
820 (not (string< "9" key)))
821 (setq value (+ (* (if (numberp value) value 0) 10)
822 (- (aref key 0) ?0))
823 factor nil)
70e14c01
JB
824;; (describe-arg value sign)
825 (setq key (read-key-sequence nil t)))
2076c87c 826 (setq prefix-arg
c637ae6f 827 (cond (factor (list factor))
2076c87c
JB
828 ((numberp value) (* value sign))
829 ((= sign -1) '-)))
c637ae6f
JB
830 ;; Calling universal-argument after digits
831 ;; terminates the argument but is ignored.
832 (if (eq (key-binding key) 'universal-argument)
833 (progn
834 (describe-arg value sign)
70e14c01 835 (setq key (read-key-sequence nil t))))
d70202c0 836 (setq unread-command-events (listify-key-sequence key))))
c637ae6f
JB
837
838(defun describe-arg (value sign)
839 (cond ((numberp value)
840 (message "Arg: %d" (* value sign)))
841 ((consp value)
842 (message "Arg: [%d]" (car value)))
843 ((< sign 0)
844 (message "Arg: -"))))
2076c87c
JB
845
846(defun digit-argument (arg)
847 "Part of the numeric argument for the next command.
848\\[universal-argument] following digits or minus sign ends the argument."
849 (interactive "P")
c637ae6f
JB
850 (prefix-arg-internal (char-to-string (logand last-command-char ?\177))
851 nil arg))
2076c87c
JB
852
853(defun negative-argument (arg)
854 "Begin a negative numeric argument for the next command.
855\\[universal-argument] following digits or minus sign ends the argument."
856 (interactive "P")
c637ae6f 857 (prefix-arg-internal "-" nil arg))
2076c87c
JB
858\f
859(defun forward-to-indentation (arg)
860 "Move forward ARG lines and position at first nonblank character."
861 (interactive "p")
862 (forward-line arg)
863 (skip-chars-forward " \t"))
864
865(defun backward-to-indentation (arg)
866 "Move backward ARG lines and position at first nonblank character."
867 (interactive "p")
868 (forward-line (- arg))
869 (skip-chars-forward " \t"))
870
38ebcf29 871(defvar kill-whole-line nil
dff7d67f 872 "*If non-nil, `kill-line' with no arg at beg of line kills the whole line.")
38ebcf29 873
2076c87c 874(defun kill-line (&optional arg)
dff7d67f 875 "Kill the rest of the current line; if no nonblanks there, kill thru newline.
2076c87c
JB
876With prefix argument, kill that many lines from point.
877Negative arguments kill lines backward.
878
879When calling from a program, nil means \"no arg\",
dff7d67f
RS
880a number counts as a prefix arg.
881
882If `kill-whole-line' is non-nil, then kill the whole line
883when given no argument at the beginning of a line."
2076c87c
JB
884 (interactive "P")
885 (kill-region (point)
c2e8a012
JB
886 ;; Don't shift point before doing the delete; that way,
887 ;; undo will record the right position of point.
888 (save-excursion
2076c87c
JB
889 (if arg
890 (forward-line (prefix-numeric-value arg))
891 (if (eobp)
892 (signal 'end-of-buffer nil))
38ebcf29 893 (if (or (looking-at "[ \t]*$") (and kill-whole-line (bolp)))
2076c87c
JB
894 (forward-line 1)
895 (end-of-line)))
896 (point))))
897\f
70e14c01
JB
898;;;; Window system cut and paste hooks.
899
900(defvar interprogram-cut-function nil
901 "Function to call to make a killed region available to other programs.
902
903Most window systems provide some sort of facility for cutting and
9f112a3d
RS
904pasting text between the windows of different programs.
905This variable holds a function that Emacs calls whenever text
906is put in the kill ring, to make the new kill available to other
70e14c01
JB
907programs.
908
9f112a3d
RS
909The function takes one or two arguments.
910The first argument, TEXT, is a string containing
911the text which should be made available.
912The second, PUSH, if non-nil means this is a \"new\" kill;
913nil means appending to an \"old\" kill.")
70e14c01
JB
914
915(defvar interprogram-paste-function nil
916 "Function to call to get text cut from other programs.
917
918Most window systems provide some sort of facility for cutting and
9f112a3d
RS
919pasting text between the windows of different programs.
920This variable holds a function that Emacs calls to obtain
70e14c01
JB
921text that other programs have provided for pasting.
922
923The function should be called with no arguments. If the function
924returns nil, then no other program has provided such text, and the top
925of the Emacs kill ring should be used. If the function returns a
daa37602
JB
926string, that string should be put in the kill ring as the latest kill.
927
928Note that the function should return a string only if a program other
929than Emacs has provided a string for pasting; if Emacs provided the
930most recent string, the function should return nil. If it is
931difficult to tell whether Emacs or some other program provided the
932current string, it is probably good enough to return nil if the string
933is equal (according to `string=') to the last text Emacs provided.")
70e14c01
JB
934
935
936\f
937;;;; The kill ring data structure.
2076c87c
JB
938
939(defvar kill-ring nil
70e14c01
JB
940 "List of killed text sequences.
941Since the kill ring is supposed to interact nicely with cut-and-paste
942facilities offered by window systems, use of this variable should
943interact nicely with `interprogram-cut-function' and
944`interprogram-paste-function'. The functions `kill-new',
945`kill-append', and `current-kill' are supposed to implement this
946interaction; you may want to use them instead of manipulating the kill
947ring directly.")
2076c87c
JB
948
949(defconst kill-ring-max 30
950 "*Maximum length of kill ring before oldest elements are thrown away.")
951
952(defvar kill-ring-yank-pointer nil
953 "The tail of the kill ring whose car is the last thing yanked.")
954
70e14c01
JB
955(defun kill-new (string)
956 "Make STRING the latest kill in the kill ring.
957Set the kill-ring-yank pointer to point to it.
958If `interprogram-cut-function' is non-nil, apply it to STRING."
959 (setq kill-ring (cons string kill-ring))
960 (if (> (length kill-ring) kill-ring-max)
961 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
962 (setq kill-ring-yank-pointer kill-ring)
963 (if interprogram-cut-function
9f112a3d 964 (funcall interprogram-cut-function string t)))
70e14c01 965
2076c87c 966(defun kill-append (string before-p)
70e14c01
JB
967 "Append STRING to the end of the latest kill in the kill ring.
968If BEFORE-P is non-nil, prepend STRING to the kill.
88c1aa79 969If `interprogram-cut-function' is set, pass the resulting kill to
70e14c01 970it."
2076c87c
JB
971 (setcar kill-ring
972 (if before-p
973 (concat string (car kill-ring))
70e14c01
JB
974 (concat (car kill-ring) string)))
975 (if interprogram-cut-function
976 (funcall interprogram-cut-function (car kill-ring))))
977
978(defun current-kill (n &optional do-not-move)
979 "Rotate the yanking point by N places, and then return that kill.
980If N is zero, `interprogram-paste-function' is set, and calling it
981returns a string, then that string is added to the front of the
982kill ring and returned as the latest kill.
983If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
984yanking point; just return the Nth kill forward."
985 (let ((interprogram-paste (and (= n 0)
986 interprogram-paste-function
987 (funcall interprogram-paste-function))))
988 (if interprogram-paste
989 (progn
990 ;; Disable the interprogram cut function when we add the new
991 ;; text to the kill ring, so Emacs doesn't try to own the
992 ;; selection, with identical text.
993 (let ((interprogram-cut-function nil))
994 (kill-new interprogram-paste))
995 interprogram-paste)
996 (or kill-ring (error "Kill ring is empty"))
997 (let* ((length (length kill-ring))
998 (ARGth-kill-element
999 (nthcdr (% (+ n (- length (length kill-ring-yank-pointer)))
1000 length)
1001 kill-ring)))
1002 (or do-not-move
1003 (setq kill-ring-yank-pointer ARGth-kill-element))
1004 (car ARGth-kill-element)))))
c88ab9ce 1005
c88ab9ce 1006
70e14c01
JB
1007\f
1008;;;; Commands for manipulating the kill ring.
c88ab9ce 1009
2076c87c
JB
1010(defun kill-region (beg end)
1011 "Kill between point and mark.
1012The text is deleted but saved in the kill ring.
1013The command \\[yank] can retrieve it from there.
1014\(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
2aa7a8bf
JB
1015If the buffer is read-only, Emacs will beep and refrain from deleting
1016the text, but put the text in the kill ring anyway. This means that
1017you can use the killing commands to copy text from a read-only buffer.
2076c87c
JB
1018
1019This is the primitive for programs to kill text (as opposed to deleting it).
1020Supply two arguments, character numbers indicating the stretch of text
1021 to be killed.
1022Any command that calls this function is a \"kill command\".
1023If the previous command was also a kill command,
1024the text killed this time appends to the text killed last time
1025to make one entry in the kill ring."
2aa7a8bf 1026 (interactive "r")
70e14c01 1027 (cond
2aa7a8bf
JB
1028
1029 ;; If the buffer is read-only, we should beep, in case the person
1030 ;; just isn't aware of this. However, there's no harm in putting
1031 ;; the region's text in the kill ring, anyway.
1032 (buffer-read-only
1033 (copy-region-as-kill beg end)
1537a263
JB
1034 ;; This should always barf, and give us the correct error.
1035 (barf-if-buffer-read-only))
2aa7a8bf
JB
1036
1037 ;; In certain cases, we can arrange for the undo list and the kill
1038 ;; ring to share the same string object. This code does that.
70e14c01
JB
1039 ((not (or (eq buffer-undo-list t)
1040 (eq last-command 'kill-region)
1041 (eq beg end)))
1042 ;; Don't let the undo list be truncated before we can even access it.
12bcd3b6
RS
1043 (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100))
1044 (old-list buffer-undo-list)
1045 tail)
70e14c01 1046 (delete-region beg end)
12bcd3b6
RS
1047 ;; Search back in buffer-undo-list for this string,
1048 ;; in case a change hook made property changes.
1049 (setq tail buffer-undo-list)
1050 (while (not (stringp (car (car tail))))
1051 (setq tail (cdr tail)))
70e14c01
JB
1052 ;; Take the same string recorded for undo
1053 ;; and put it in the kill-ring.
12bcd3b6 1054 (kill-new (car (car tail)))
70e14c01 1055 (setq this-command 'kill-region)))
2aa7a8bf 1056
70e14c01 1057 (t
2076c87c 1058 (copy-region-as-kill beg end)
70e14c01 1059 (delete-region beg end))))
2076c87c 1060
2076c87c
JB
1061(defun copy-region-as-kill (beg end)
1062 "Save the region as if killed, but don't kill it.
46947372
JB
1063If `interprogram-cut-function' is non-nil, also save the text for a window
1064system cut and paste."
2076c87c
JB
1065 (interactive "r")
1066 (if (eq last-command 'kill-region)
1067 (kill-append (buffer-substring beg end) (< end beg))
70e14c01
JB
1068 (kill-new (buffer-substring beg end)))
1069 (setq this-command 'kill-region)
2076c87c
JB
1070 nil)
1071
1072(defun kill-ring-save (beg end)
0964e562 1073 "Save the region as if killed, but don't kill it.
230c6b36 1074This command is similar to `copy-region-as-kill', except that it gives
0964e562
JB
1075visual feedback indicating the extent of the region being copied.
1076If `interprogram-cut-function' is non-nil, also save the text for a window
1077system cut and paste."
2076c87c
JB
1078 (interactive "r")
1079 (copy-region-as-kill beg end)
3a801d0c 1080 (if (interactive-p)
66050f10
RS
1081 (let ((other-end (if (= (point) beg) end beg))
1082 (opoint (point))
1083 ;; Inhibit quitting so we can make a quit here
1084 ;; look like a C-g typed as a command.
1085 (inhibit-quit t))
1086 (if (pos-visible-in-window-p other-end (selected-window))
1087 (progn
1088 ;; Swap point and mark.
1089 (set-marker (mark-marker) (point) (current-buffer))
1090 (goto-char other-end)
1091 (sit-for 1)
1092 ;; Swap back.
1093 (set-marker (mark-marker) other-end (current-buffer))
1094 (goto-char opoint)
1095 ;; If user quit, deactivate the mark
1096 ;; as C-g would as a command.
1097 (and quit-flag transient-mark-mode mark-active
1098 (progn
1099 (message "foo")
1100 (setq mark-active nil)
1101 (run-hooks 'deactivate-mark-hook))))
1102 (let* ((killed-text (current-kill 0))
1103 (message-len (min (length killed-text) 40)))
1104 (if (= (point) beg)
1105 ;; Don't say "killed"; that is misleading.
1106 (message "Saved text until \"%s\""
1107 (substring killed-text (- message-len)))
1108 (message "Saved text from \"%s\""
1109 (substring killed-text 0 message-len))))))))
2076c87c
JB
1110
1111(defun append-next-kill ()
ff1fbe3e 1112 "Cause following command, if it kills, to append to previous kill."
2076c87c
JB
1113 (interactive)
1114 (if (interactive-p)
1115 (progn
1116 (setq this-command 'kill-region)
1117 (message "If the next command is a kill, it will append"))
1118 (setq last-command 'kill-region)))
1119
2076c87c 1120(defun yank-pop (arg)
ff1fbe3e
RS
1121 "Replace just-yanked stretch of killed text with a different stretch.
1122This command is allowed only immediately after a `yank' or a `yank-pop'.
2076c87c 1123At such a time, the region contains a stretch of reinserted
ff1fbe3e 1124previously-killed text. `yank-pop' deletes that text and inserts in its
2076c87c
JB
1125place a different stretch of killed text.
1126
1127With no argument, the previous kill is inserted.
ff1fbe3e
RS
1128With argument N, insert the Nth previous kill.
1129If N is negative, this is a more recent kill.
2076c87c
JB
1130
1131The sequence of kills wraps around, so that after the oldest one
1132comes the newest one."
1133 (interactive "*p")
1134 (if (not (eq last-command 'yank))
1135 (error "Previous command was not a yank"))
1136 (setq this-command 'yank)
9a1277dd
RS
1137 (let ((before (< (point) (mark t))))
1138 (delete-region (point) (mark t))
fd0f4056 1139 (set-marker (mark-marker) (point) (current-buffer))
70e14c01 1140 (insert (current-kill arg))
fd0f4056
RS
1141 (if before
1142 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
1143 ;; It is cleaner to avoid activation, even though the command
1144 ;; loop would deactivate the mark because we inserted text.
1145 (goto-char (prog1 (mark t)
1146 (set-marker (mark-marker) (point) (current-buffer))))))
0964e562 1147 nil)
2076c87c
JB
1148
1149(defun yank (&optional arg)
1150 "Reinsert the last stretch of killed text.
1151More precisely, reinsert the stretch of killed text most recently
ff1fbe3e
RS
1152killed OR yanked. Put point at end, and set mark at beginning.
1153With just C-u as argument, same but put point at beginning (and mark at end).
1154With argument N, reinsert the Nth most recently killed stretch of killed
2076c87c
JB
1155text.
1156See also the command \\[yank-pop]."
1157 (interactive "*P")
2076c87c 1158 (push-mark (point))
70e14c01
JB
1159 (insert (current-kill (cond
1160 ((listp arg) 0)
1161 ((eq arg '-) -1)
1162 (t (1- arg)))))
2076c87c 1163 (if (consp arg)
fd0f4056
RS
1164 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
1165 ;; It is cleaner to avoid activation, even though the command
1166 ;; loop would deactivate the mark because we inserted text.
1167 (goto-char (prog1 (mark t)
1168 (set-marker (mark-marker) (point) (current-buffer)))))
0964e562 1169 nil)
70e14c01
JB
1170
1171(defun rotate-yank-pointer (arg)
1172 "Rotate the yanking point in the kill ring.
1173With argument, rotate that many kills forward (or backward, if negative)."
1174 (interactive "p")
1175 (current-kill arg))
1176
2076c87c
JB
1177\f
1178(defun insert-buffer (buffer)
1179 "Insert after point the contents of BUFFER.
1180Puts mark after the inserted text.
1181BUFFER may be a buffer or a buffer name."
58ff020d
RS
1182 (interactive (list (progn (barf-if-buffer-read-only)
1183 (read-buffer "Insert buffer: " (other-buffer) t))))
2076c87c
JB
1184 (or (bufferp buffer)
1185 (setq buffer (get-buffer buffer)))
1186 (let (start end newmark)
1187 (save-excursion
1188 (save-excursion
1189 (set-buffer buffer)
1190 (setq start (point-min) end (point-max)))
1191 (insert-buffer-substring buffer start end)
1192 (setq newmark (point)))
1537a263
JB
1193 (push-mark newmark))
1194 nil)
2076c87c
JB
1195
1196(defun append-to-buffer (buffer start end)
1197 "Append to specified buffer the text of the region.
1198It is inserted into that buffer before its point.
1199
1200When calling from a program, give three arguments:
1201BUFFER (or buffer name), START and END.
1202START and END specify the portion of the current buffer to be copied."
70e14c01 1203 (interactive
23efee2c
RS
1204 (list (read-buffer "Append to buffer: " (other-buffer nil t))
1205 (region-beginning) (region-end)))
2076c87c
JB
1206 (let ((oldbuf (current-buffer)))
1207 (save-excursion
1208 (set-buffer (get-buffer-create buffer))
1209 (insert-buffer-substring oldbuf start end))))
1210
1211(defun prepend-to-buffer (buffer start end)
1212 "Prepend to specified buffer the text of the region.
1213It is inserted into that buffer after its point.
1214
1215When calling from a program, give three arguments:
1216BUFFER (or buffer name), START and END.
1217START and END specify the portion of the current buffer to be copied."
1218 (interactive "BPrepend to buffer: \nr")
1219 (let ((oldbuf (current-buffer)))
1220 (save-excursion
1221 (set-buffer (get-buffer-create buffer))
1222 (save-excursion
1223 (insert-buffer-substring oldbuf start end)))))
1224
1225(defun copy-to-buffer (buffer start end)
1226 "Copy to specified buffer the text of the region.
1227It is inserted into that buffer, replacing existing text there.
1228
1229When calling from a program, give three arguments:
1230BUFFER (or buffer name), START and END.
1231START and END specify the portion of the current buffer to be copied."
1232 (interactive "BCopy to buffer: \nr")
1233 (let ((oldbuf (current-buffer)))
1234 (save-excursion
1235 (set-buffer (get-buffer-create buffer))
1236 (erase-buffer)
1237 (save-excursion
1238 (insert-buffer-substring oldbuf start end)))))
1239\f
0bf0c097
RS
1240(defvar mark-even-if-inactive nil
1241 "*Non-nil means you can use the mark even when inactive.
1242This option makes a difference in Transient Mark mode.
1243When the option is non-nil, deactivation of the mark
1244turns off region highlighting, but commands that use the mark
1245behave as if the mark were still active.")
1246
62d1c1fc
RM
1247(put 'mark-inactive 'error-conditions '(mark-inactive error))
1248(put 'mark-inactive 'error-message "The mark is not active now")
1249
af39530e 1250(defun mark (&optional force)
c7c8b31e 1251 "Return this buffer's mark value as integer; error if mark inactive.
af39530e 1252If optional argument FORCE is non-nil, access the mark value
c7c8b31e
RS
1253even if the mark is not currently active, and return nil
1254if there is no mark at all.
af39530e 1255
2076c87c
JB
1256If you are using this in an editing command, you are most likely making
1257a mistake; see the documentation of `set-mark'."
0bf0c097 1258 (if (or force mark-active mark-even-if-inactive)
af39530e 1259 (marker-position (mark-marker))
62d1c1fc 1260 (signal 'mark-inactive nil)))
2076c87c
JB
1261
1262(defun set-mark (pos)
1263 "Set this buffer's mark to POS. Don't use this function!
1264That is to say, don't use this function unless you want
1265the user to see that the mark has moved, and you want the previous
1266mark position to be lost.
1267
1268Normally, when a new mark is set, the old one should go on the stack.
1269This is why most applications should use push-mark, not set-mark.
1270
ff1fbe3e 1271Novice Emacs Lisp programmers often try to use the mark for the wrong
2076c87c
JB
1272purposes. The mark saves a location for the user's convenience.
1273Most editing commands should not alter the mark.
1274To remember a location for internal use in the Lisp program,
1275store it in a Lisp variable. Example:
1276
1277 (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
1278
af39530e
RS
1279 (setq mark-active t)
1280 (run-hooks 'activate-mark-hook)
2076c87c
JB
1281 (set-marker (mark-marker) pos (current-buffer)))
1282
1283(defvar mark-ring nil
1284 "The list of saved former marks of the current buffer,
1285most recent first.")
1286(make-variable-buffer-local 'mark-ring)
1287
1288(defconst mark-ring-max 16
1289 "*Maximum size of mark ring. Start discarding off end if gets this big.")
1290
1291(defun set-mark-command (arg)
1292 "Set mark at where point is, or jump to mark.
79926889
JB
1293With no prefix argument, set mark, and push old mark position on mark ring.
1294With argument, jump to mark, and pop a new position for mark off the ring.
2076c87c 1295
ff1fbe3e 1296Novice Emacs Lisp programmers often try to use the mark for the wrong
2076c87c
JB
1297purposes. See the documentation of `set-mark' for more information."
1298 (interactive "P")
1299 (if (null arg)
9a1277dd 1300 (progn
fd0f4056 1301 (push-mark nil nil t))
af39530e 1302 (if (null (mark t))
2076c87c 1303 (error "No mark set in this buffer")
9a1277dd 1304 (goto-char (mark t))
2076c87c
JB
1305 (pop-mark))))
1306
fd0f4056 1307(defun push-mark (&optional location nomsg activate)
2076c87c 1308 "Set mark at LOCATION (point, by default) and push old mark on mark ring.
fd0f4056 1309Display `Mark set' unless the optional second arg NOMSG is non-nil.
8cdc660f 1310In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil.
2076c87c 1311
ff1fbe3e 1312Novice Emacs Lisp programmers often try to use the mark for the wrong
9a1277dd
RS
1313purposes. See the documentation of `set-mark' for more information.
1314
1315In Transient Mark mode, this does not activate the mark."
af39530e 1316 (if (null (mark t))
2076c87c
JB
1317 nil
1318 (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
1319 (if (> (length mark-ring) mark-ring-max)
1320 (progn
1321 (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
1322 (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
9a1277dd 1323 (set-marker (mark-marker) (or location (point)) (current-buffer))
2076c87c
JB
1324 (or nomsg executing-macro (> (minibuffer-depth) 0)
1325 (message "Mark set"))
8cdc660f
RS
1326 (if (or activate (not transient-mark-mode))
1327 (set-mark (mark t)))
2076c87c
JB
1328 nil)
1329
1330(defun pop-mark ()
1331 "Pop off mark ring into the buffer's actual mark.
1332Does not set point. Does nothing if mark ring is empty."
1333 (if mark-ring
1334 (progn
1335 (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
9a1277dd
RS
1336 (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
1337 (if transient-mark-mode
1338 (setq mark-active nil))
2076c87c 1339 (move-marker (car mark-ring) nil)
9a1277dd 1340 (if (null (mark t)) (ding))
2076c87c
JB
1341 (setq mark-ring (cdr mark-ring)))))
1342
dff7d67f 1343(define-function 'exchange-dot-and-mark 'exchange-point-and-mark)
2076c87c 1344(defun exchange-point-and-mark ()
af39530e
RS
1345 "Put the mark where point is now, and point where the mark is now.
1346This command works even when the mark is not active,
1347and it reactivates the mark."
2076c87c 1348 (interactive nil)
af39530e 1349 (let ((omark (mark t)))
2076c87c
JB
1350 (if (null omark)
1351 (error "No mark set in this buffer"))
1352 (set-mark (point))
1353 (goto-char omark)
1354 nil))
e23c2c21
RS
1355
1356(defun transient-mark-mode (arg)
1357 "Toggle Transient Mark mode.
b411b5fa 1358With arg, turn Transient Mark mode on if arg is positive, off otherwise.
e23c2c21
RS
1359
1360In Transient Mark mode, changing the buffer \"deactivates\" the mark.
1361While the mark is active, the region is highlighted."
1362 (interactive "P")
1363 (setq transient-mark-mode
1364 (if (null arg)
1365 (not transient-mark-mode)
1366 (> (prefix-numeric-value arg) 0))))
2076c87c 1367\f
38ebcf29 1368(defvar next-line-add-newlines t
dff7d67f 1369 "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error.")
38ebcf29 1370
2076c87c
JB
1371(defun next-line (arg)
1372 "Move cursor vertically down ARG lines.
1373If there is no character in the target line exactly under the current column,
1374the cursor is positioned after the character in that line which spans this
1375column, or at the end of the line if it is not long enough.
38ebcf29
ER
1376If there is no line in the buffer after this one, behavior depends on the
1377value of next-line-add-newlines. If non-nil, a newline character is inserted
1378to create a line and the cursor moves to that line, otherwise the cursor is
1379moved to the end of the buffer (if already at the end of the buffer, an error
1380is signaled).
2076c87c
JB
1381
1382The command \\[set-goal-column] can be used to create
1383a semipermanent goal column to which this command always moves.
1384Then it does not try to move vertically. This goal column is stored
1385in `goal-column', which is nil when there is none.
1386
1387If you are thinking of using this in a Lisp program, consider
1388using `forward-line' instead. It is usually easier to use
1389and more reliable (no dependence on goal column, etc.)."
1390 (interactive "p")
38ebcf29
ER
1391 (let ((opoint (point)))
1392 (if next-line-add-newlines
1393 (if (/= arg 1)
1394 (line-move arg)
1395 (forward-line 1)
1396 (if (or (= opoint (point)) (not (eq (preceding-char) ?\n)))
1397 (insert ?\n)
1398 (goto-char opoint)
1399 (line-move arg)))
1400 (if (eobp)
1401 (signal 'end-of-buffer nil))
1402 (line-move arg)
1403 (if (= opoint (point))
1404 (end-of-line))))
2076c87c
JB
1405 nil)
1406
1407(defun previous-line (arg)
1408 "Move cursor vertically up ARG lines.
1409If there is no character in the target line exactly over the current column,
1410the cursor is positioned after the character in that line which spans this
1411column, or at the end of the line if it is not long enough.
1412
1413The command \\[set-goal-column] can be used to create
1414a semipermanent goal column to which this command always moves.
1415Then it does not try to move vertically.
1416
1417If you are thinking of using this in a Lisp program, consider using
c2e8a012 1418`forward-line' with a negative argument instead. It is usually easier
2076c87c
JB
1419to use and more reliable (no dependence on goal column, etc.)."
1420 (interactive "p")
1421 (line-move (- arg))
1422 nil)
1423
1424(defconst track-eol nil
1425 "*Non-nil means vertical motion starting at end of line keeps to ends of lines.
1426This means moving to the end of each line moved onto.
1427The beginning of a blank line does not count as the end of a line.")
1428
912c6728
RS
1429(defvar goal-column nil
1430 "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil.")
1431(make-variable-buffer-local 'goal-column)
2076c87c
JB
1432
1433(defvar temporary-goal-column 0
1434 "Current goal column for vertical motion.
1435It is the column where point was
1436at the start of current run of vertical motion commands.
c637ae6f 1437When the `track-eol' feature is doing its job, the value is 9999.")
2076c87c
JB
1438
1439(defun line-move (arg)
1440 (if (not (or (eq last-command 'next-line)
1441 (eq last-command 'previous-line)))
1442 (setq temporary-goal-column
1443 (if (and track-eol (eolp)
1444 ;; Don't count beg of empty line as end of line
1445 ;; unless we just did explicit end-of-line.
1446 (or (not (bolp)) (eq last-command 'end-of-line)))
1447 9999
1448 (current-column))))
1449 (if (not (integerp selective-display))
1450 (forward-line arg)
1451 ;; Move by arg lines, but ignore invisible ones.
1452 (while (> arg 0)
1453 (vertical-motion 1)
1454 (forward-char -1)
1455 (forward-line 1)
1456 (setq arg (1- arg)))
1457 (while (< arg 0)
1458 (vertical-motion -1)
1459 (beginning-of-line)
1460 (setq arg (1+ arg))))
1461 (move-to-column (or goal-column temporary-goal-column))
1462 nil)
1463
d5ab2033
JB
1464;;; Many people have said they rarely use this feature, and often type
1465;;; it by accident. Maybe it shouldn't even be on a key.
1466(put 'set-goal-column 'disabled t)
2076c87c
JB
1467
1468(defun set-goal-column (arg)
1469 "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
1470Those commands will move to this position in the line moved to
1471rather than trying to keep the same horizontal position.
1472With a non-nil argument, clears out the goal column
912c6728
RS
1473so that \\[next-line] and \\[previous-line] resume vertical motion.
1474The goal column is stored in the variable `goal-column'."
2076c87c
JB
1475 (interactive "P")
1476 (if arg
1477 (progn
1478 (setq goal-column nil)
1479 (message "No goal column"))
1480 (setq goal-column (current-column))
1481 (message (substitute-command-keys
1482 "Goal column %d (use \\[set-goal-column] with an arg to unset it)")
1483 goal-column))
1484 nil)
1485\f
0d5bbbf7
ER
1486;;; Partial support for horizontal autoscrolling. Someday, this feature
1487;;; will be built into the C level and all the (hscroll-point-visible) calls
1488;;; will go away.
1489
1490(defvar hscroll-step 0
1491 "*The number of columns to try scrolling a window by when point moves out.
1492If that fails to bring point back on frame, point is centered instead.
1493If this is zero, point is always centered after it moves off frame.")
1494
1495(defun hscroll-point-visible ()
1496 "Scrolls the window horizontally to make point visible."
1f3696d7
JB
1497 (let* ((here (current-column))
1498 (left (window-hscroll))
1499 (right (- (+ left (window-width)) 3)))
1500 (cond
1501 ;; Should we recenter?
1502 ((or (< here (- left hscroll-step))
1503 (> here (+ right hscroll-step)))
1504 (set-window-hscroll
1505 (selected-window)
1506 ;; Recenter, but don't show too much white space off the end of
1507 ;; the line.
1508 (max 0
1509 (min (- (save-excursion (end-of-line) (current-column))
1510 (window-width)
1511 -5)
1512 (- here (/ (window-width) 2))))))
1513 ;; Should we scroll left?
1514 ((> here right)
1515 (scroll-left hscroll-step))
1516 ;; Or right?
1517 ((< here left)
1518 (scroll-right hscroll-step)))))
0d5bbbf7 1519
dff7d67f
RS
1520;; rms: (1) The definitions of arrow keys should not simply restate
1521;; what keys they are. The arrow keys should run the ordinary commands.
1522;; (2) The arrow keys are just one of many common ways of moving point
1523;; within a line. Real horizontal autoscrolling would be a good feature,
1524;; but supporting it only for arrow keys is too incomplete to be desirable.
1525
1526;;;;; Make arrow keys do the right thing for improved terminal support
1527;;;;; When we implement true horizontal autoscrolling, right-arrow and
1528;;;;; left-arrow can lose the (if truncate-lines ...) clause and become
1529;;;;; aliases. These functions are bound to the corresponding keyboard
1530;;;;; events in loaddefs.el.
1531
1532;;(defun right-arrow (arg)
1533;; "Move right one character on the screen (with prefix ARG, that many chars).
1534;;Scroll right if needed to keep point horizontally onscreen."
1535;; (interactive "P")
1536;; (forward-char arg)
1537;; (hscroll-point-visible))
1538
1539;;(defun left-arrow (arg)
1540;; "Move left one character on the screen (with prefix ARG, that many chars).
1541;;Scroll left if needed to keep point horizontally onscreen."
1542;; (interactive "P")
1543;; (backward-char arg)
1544;; (hscroll-point-visible))
38ebcf29 1545\f
2076c87c
JB
1546(defun transpose-chars (arg)
1547 "Interchange characters around point, moving forward one character.
1548With prefix arg ARG, effect is to take character before point
1549and drag it forward past ARG other characters (backward if ARG negative).
1550If no argument and at end of line, the previous two chars are exchanged."
1551 (interactive "*P")
1552 (and (null arg) (eolp) (forward-char -1))
1553 (transpose-subr 'forward-char (prefix-numeric-value arg)))
1554
1555(defun transpose-words (arg)
1556 "Interchange words around point, leaving point at end of them.
1557With prefix arg ARG, effect is to take word before or around point
1558and drag it forward past ARG other words (backward if ARG negative).
1559If ARG is zero, the words around or after point and around or after mark
1560are interchanged."
1561 (interactive "*p")
1562 (transpose-subr 'forward-word arg))
1563
1564(defun transpose-sexps (arg)
1565 "Like \\[transpose-words] but applies to sexps.
1566Does not work on a sexp that point is in the middle of
1567if it is a list or string."
1568 (interactive "*p")
1569 (transpose-subr 'forward-sexp arg))
1570
1571(defun transpose-lines (arg)
1572 "Exchange current line and previous line, leaving point after both.
1573With argument ARG, takes previous line and moves it past ARG lines.
1574With argument 0, interchanges line point is in with line mark is in."
1575 (interactive "*p")
1576 (transpose-subr (function
1577 (lambda (arg)
1578 (if (= arg 1)
1579 (progn
1580 ;; Move forward over a line,
1581 ;; but create a newline if none exists yet.
1582 (end-of-line)
1583 (if (eobp)
1584 (newline)
1585 (forward-char 1)))
1586 (forward-line arg))))
1587 arg))
1588
1589(defun transpose-subr (mover arg)
1590 (let (start1 end1 start2 end2)
1591 (if (= arg 0)
1592 (progn
1593 (save-excursion
1594 (funcall mover 1)
1595 (setq end2 (point))
1596 (funcall mover -1)
1597 (setq start2 (point))
1598 (goto-char (mark))
1599 (funcall mover 1)
1600 (setq end1 (point))
1601 (funcall mover -1)
1602 (setq start1 (point))
1603 (transpose-subr-1))
1604 (exchange-point-and-mark)))
1605 (while (> arg 0)
1606 (funcall mover -1)
1607 (setq start1 (point))
1608 (funcall mover 1)
1609 (setq end1 (point))
1610 (funcall mover 1)
1611 (setq end2 (point))
1612 (funcall mover -1)
1613 (setq start2 (point))
1614 (transpose-subr-1)
1615 (goto-char end2)
1616 (setq arg (1- arg)))
1617 (while (< arg 0)
1618 (funcall mover -1)
1619 (setq start2 (point))
1620 (funcall mover -1)
1621 (setq start1 (point))
1622 (funcall mover 1)
1623 (setq end1 (point))
1624 (funcall mover 1)
1625 (setq end2 (point))
1626 (transpose-subr-1)
1627 (setq arg (1+ arg)))))
1628
1629(defun transpose-subr-1 ()
1630 (if (> (min end1 end2) (max start1 start2))
1631 (error "Don't have two things to transpose"))
1632 (let ((word1 (buffer-substring start1 end1))
1633 (word2 (buffer-substring start2 end2)))
1634 (delete-region start2 end2)
1635 (goto-char start2)
1636 (insert word1)
1637 (goto-char (if (< start1 start2) start1
1638 (+ start1 (- (length word1) (length word2)))))
1639 (delete-char (length word1))
1640 (insert word2)))
1641\f
1642(defconst comment-column 32
1643 "*Column to indent right-margin comments to.
8a8fa723
JB
1644Setting this variable automatically makes it local to the current buffer.
1645Each mode establishes a different default value for this variable; you
1646can the value for a particular mode using that mode's hook.")
2076c87c
JB
1647(make-variable-buffer-local 'comment-column)
1648
1649(defconst comment-start nil
1650 "*String to insert to start a new comment, or nil if no comment syntax defined.")
1651
1652(defconst comment-start-skip nil
1653 "*Regexp to match the start of a comment plus everything up to its body.
1654If there are any \\(...\\) pairs, the comment delimiter text is held to begin
1655at the place matched by the close of the first pair.")
1656
1657(defconst comment-end ""
1658 "*String to insert to end a new comment.
1659Should be an empty string if comments are terminated by end-of-line.")
1660
ec9a76e3
JB
1661(defconst comment-indent-hook nil
1662 "Obsolete variable for function to compute desired indentation for a comment.
1663This function is called with no args with point at the beginning of
1664the comment's starting delimiter.")
1665
1666(defconst comment-indent-function
2076c87c
JB
1667 '(lambda () comment-column)
1668 "Function to compute desired indentation for a comment.
1669This function is called with no args with point at the beginning of
1670the comment's starting delimiter.")
1671
1672(defun indent-for-comment ()
1673 "Indent this line's comment to comment column, or insert an empty comment."
1674 (interactive "*")
1675 (beginning-of-line 1)
1676 (if (null comment-start)
1677 (error "No comment syntax defined")
1678 (let* ((eolpos (save-excursion (end-of-line) (point)))
1679 cpos indent begpos)
1680 (if (re-search-forward comment-start-skip eolpos 'move)
1681 (progn (setq cpos (point-marker))
1682 ;; Find the start of the comment delimiter.
1683 ;; If there were paren-pairs in comment-start-skip,
1684 ;; position at the end of the first pair.
1685 (if (match-end 1)
1686 (goto-char (match-end 1))
9d0f559a
RM
1687 ;; If comment-start-skip matched a string with
1688 ;; internal whitespace (not final whitespace) then
1689 ;; the delimiter start at the end of that
1690 ;; whitespace. Otherwise, it starts at the
1691 ;; beginning of what was matched.
1692 (skip-syntax-backward " " (match-beginning 0))
1693 (skip-syntax-backward "^ " (match-beginning 0)))))
2076c87c
JB
1694 (setq begpos (point))
1695 ;; Compute desired indent.
1696 (if (= (current-column)
9d0f559a
RM
1697 (setq indent (if comment-indent-hook
1698 (funcall comment-indent-hook)
1699 (funcall comment-indent-function))))
2076c87c
JB
1700 (goto-char begpos)
1701 ;; If that's different from current, change it.
1702 (skip-chars-backward " \t")
1703 (delete-region (point) begpos)
1704 (indent-to indent))
1705 ;; An existing comment?
1706 (if cpos
1707 (progn (goto-char cpos)
1708 (set-marker cpos nil))
1709 ;; No, insert one.
1710 (insert comment-start)
1711 (save-excursion
1712 (insert comment-end))))))
1713
1714(defun set-comment-column (arg)
1715 "Set the comment column based on point.
1716With no arg, set the comment column to the current column.
1717With just minus as arg, kill any comment on this line.
1718With any other arg, set comment column to indentation of the previous comment
1719 and then align or create a comment on this line at that column."
1720 (interactive "P")
1721 (if (eq arg '-)
1722 (kill-comment nil)
1723 (if arg
1724 (progn
1725 (save-excursion
1726 (beginning-of-line)
1727 (re-search-backward comment-start-skip)
1728 (beginning-of-line)
1729 (re-search-forward comment-start-skip)
1730 (goto-char (match-beginning 0))
1731 (setq comment-column (current-column))
1732 (message "Comment column set to %d" comment-column))
1733 (indent-for-comment))
1734 (setq comment-column (current-column))
1735 (message "Comment column set to %d" comment-column))))
1736
1737(defun kill-comment (arg)
1738 "Kill the comment on this line, if any.
1739With argument, kill comments on that many lines starting with this one."
1740 ;; this function loses in a lot of situations. it incorrectly recognises
1741 ;; comment delimiters sometimes (ergo, inside a string), doesn't work
1742 ;; with multi-line comments, can kill extra whitespace if comment wasn't
1743 ;; through end-of-line, et cetera.
1744 (interactive "P")
1745 (or comment-start-skip (error "No comment syntax defined"))
1746 (let ((count (prefix-numeric-value arg)) endc)
1747 (while (> count 0)
1748 (save-excursion
1749 (end-of-line)
1750 (setq endc (point))
1751 (beginning-of-line)
1752 (and (string< "" comment-end)
1753 (setq endc
1754 (progn
1755 (re-search-forward (regexp-quote comment-end) endc 'move)
1756 (skip-chars-forward " \t")
1757 (point))))
1758 (beginning-of-line)
1759 (if (re-search-forward comment-start-skip endc t)
1760 (progn
1761 (goto-char (match-beginning 0))
1762 (skip-chars-backward " \t")
1763 (kill-region (point) endc)
1764 ;; to catch comments a line beginnings
1765 (indent-according-to-mode))))
1766 (if arg (forward-line 1))
1767 (setq count (1- count)))))
1768
1769(defun comment-region (beg end &optional arg)
1770 "Comment the region; third arg numeric means use ARG comment characters.
1771If ARG is negative, delete that many comment characters instead.
1772Comments are terminated on each line, even for syntax in which newline does
1773not end the comment. Blank lines do not get comments."
1774 ;; if someone wants it to only put a comment-start at the beginning and
1775 ;; comment-end at the end then typing it, C-x C-x, closing it, C-x C-x
1776 ;; is easy enough. No option is made here for other than commenting
1777 ;; every line.
1778 (interactive "r\np")
1779 (or comment-start (error "No comment syntax is defined"))
1780 (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
1781 (save-excursion
1782 (save-restriction
1783 (let ((cs comment-start) (ce comment-end))
1784 (cond ((not arg) (setq arg 1))
1785 ((> arg 1)
1786 (while (> (setq arg (1- arg)) 0)
1787 (setq cs (concat cs comment-start)
1788 ce (concat ce comment-end)))))
1789 (narrow-to-region beg end)
1790 (goto-char beg)
1791 (while (not (eobp))
1792 (if (< arg 0)
1793 (let ((count arg))
1794 (while (and (> 1 (setq count (1+ count)))
1795 (looking-at (regexp-quote cs)))
1796 (delete-char (length cs)))
1797 (if (string= "" ce) ()
1798 (setq count arg)
1799 (while (> 1 (setq count (1+ count)))
1800 (end-of-line)
1801 ;; this is questionable if comment-end ends in whitespace
1802 ;; that is pretty brain-damaged though
1803 (skip-chars-backward " \t")
1804 (backward-char (length ce))
1805 (if (looking-at (regexp-quote ce))
6e88ed49
RS
1806 (delete-char (length ce)))))
1807 (forward-line 1))
2076c87c
JB
1808 (if (looking-at "[ \t]*$") ()
1809 (insert cs)
1810 (if (string= "" ce) ()
1811 (end-of-line)
1812 (insert ce)))
1813 (search-forward "\n" nil 'move)))))))
1814\f
1815(defun backward-word (arg)
1816 "Move backward until encountering the end of a word.
1817With argument, do this that many times.
ff1fbe3e 1818In programs, it is faster to call `forward-word' with negative arg."
2076c87c
JB
1819 (interactive "p")
1820 (forward-word (- arg)))
1821
1822(defun mark-word (arg)
1823 "Set mark arg words away from point."
1824 (interactive "p")
1825 (push-mark
1826 (save-excursion
1827 (forward-word arg)
fd0f4056
RS
1828 (point))
1829 nil t))
2076c87c
JB
1830
1831(defun kill-word (arg)
1832 "Kill characters forward until encountering the end of a word.
1833With argument, do this that many times."
1834 (interactive "p")
01b8e020 1835 (kill-region (point) (save-excursion (forward-word arg) (point))))
2076c87c
JB
1836
1837(defun backward-kill-word (arg)
1838 "Kill characters backward until encountering the end of a word.
1839With argument, do this that many times."
1840 (interactive "p")
1841 (kill-word (- arg)))
d7c64071
ER
1842
1843(defun current-word ()
1844 "Return the word point is on as a string, if it's between two
1845word-constituent characters. If not, but it immediately follows one,
1846move back first. Otherwise, if point precedes a word constituent,
1847move forward first. Otherwise, move backwards until a word constituent
1848is found and get that word; if you reach a newline first, move forward
1849instead."
1850 (interactive)
1851 (save-excursion
1852 (let ((oldpoint (point)) (start (point)) (end (point)))
1853 (skip-syntax-backward "w_") (setq start (point))
1854 (goto-char oldpoint)
1855 (skip-syntax-forward "w_") (setq end (point))
1856 (if (and (eq start oldpoint) (eq end oldpoint))
1857 (progn
1858 (skip-syntax-backward "^w_"
1859 (save-excursion (beginning-of-line) (point)))
1860 (if (eq (preceding-char) ?\n)
1861 (progn
1862 (skip-syntax-forward "^w_")
1863 (setq start (point))
1864 (skip-syntax-forward "w_")
1865 (setq end (point)))
1866 (setq end (point))
1867 (skip-syntax-backward "w_")
1868 (setq start (point)))))
1869 (buffer-substring start end))))
2076c87c
JB
1870\f
1871(defconst fill-prefix nil
1872 "*String for filling to insert at front of new line, or nil for none.
1873Setting this variable automatically makes it local to the current buffer.")
1874(make-variable-buffer-local 'fill-prefix)
1875
1876(defconst auto-fill-inhibit-regexp nil
1877 "*Regexp to match lines which should not be auto-filled.")
1878
1879(defun do-auto-fill ()
1880 (let (give-up)
1881 (or (and auto-fill-inhibit-regexp
1882 (save-excursion (beginning-of-line)
1883 (looking-at auto-fill-inhibit-regexp)))
1884 (while (and (not give-up) (> (current-column) fill-column))
1885 (let ((fill-point
1886 (let ((opoint (point)))
1887 (save-excursion
1888 (move-to-column (1+ fill-column))
1889 (skip-chars-backward "^ \t\n")
1890 (if (bolp)
1891 (re-search-forward "[ \t]" opoint t))
1892 (skip-chars-backward " \t")
1893 (point)))))
1894 ;; If there is a space on the line before fill-point,
1895 ;; and nonspaces precede it, break the line there.
1896 (if (save-excursion
1897 (goto-char fill-point)
1898 (not (bolp)))
1899 ;; If point is at the fill-point, do not `save-excursion'.
1900 ;; Otherwise, if a comment prefix or fill-prefix is inserted,
1901 ;; point will end up before it rather than after it.
1902 (if (save-excursion
1903 (skip-chars-backward " \t")
1904 (= (point) fill-point))
1905 (indent-new-comment-line)
1906 (save-excursion
1907 (goto-char fill-point)
1908 (indent-new-comment-line)))
1909 ;; No place to break => stop trying.
1910 (setq give-up t)))))))
1911
1912(defconst comment-multi-line nil
1913 "*Non-nil means \\[indent-new-comment-line] should continue same comment
c88ab9ce
ER
1914on new line, with no new terminator or starter.
1915This is obsolete because you might as well use \\[newline-and-indent].")
2076c87c
JB
1916
1917(defun indent-new-comment-line ()
1918 "Break line at point and indent, continuing comment if presently within one.
c88ab9ce
ER
1919The body of the continued comment is indented under the previous comment line.
1920
1921This command is intended for styles where you write a comment per line,
1922starting a new comment (and terminating it if necessary) on each line.
1923If you want to continue one comment across several lines, use \\[newline-and-indent]."
2076c87c
JB
1924 (interactive "*")
1925 (let (comcol comstart)
1926 (skip-chars-backward " \t")
1927 (delete-region (point)
1928 (progn (skip-chars-forward " \t")
1929 (point)))
1930 (insert ?\n)
c88ab9ce
ER
1931 (if (not comment-multi-line)
1932 (save-excursion
1933 (if (and comment-start-skip
1934 (let ((opoint (point)))
1935 (forward-line -1)
1936 (re-search-forward comment-start-skip opoint t)))
1937 ;; The old line is a comment.
1938 ;; Set WIN to the pos of the comment-start.
1939 ;; But if the comment is empty, look at preceding lines
1940 ;; to find one that has a nonempty comment.
1941 (let ((win (match-beginning 0)))
1942 (while (and (eolp) (not (bobp))
1943 (let (opoint)
1944 (beginning-of-line)
1945 (setq opoint (point))
1946 (forward-line -1)
1947 (re-search-forward comment-start-skip opoint t)))
1948 (setq win (match-beginning 0)))
1949 ;; Indent this line like what we found.
1950 (goto-char win)
1951 (setq comcol (current-column))
1952 (setq comstart (buffer-substring (point) (match-end 0)))))))
2076c87c
JB
1953 (if comcol
1954 (let ((comment-column comcol)
1955 (comment-start comstart)
1956 (comment-end comment-end))
1957 (and comment-end (not (equal comment-end ""))
c88ab9ce 1958; (if (not comment-multi-line)
2076c87c
JB
1959 (progn
1960 (forward-char -1)
1961 (insert comment-end)
1962 (forward-char 1))
c88ab9ce
ER
1963; (setq comment-column (+ comment-column (length comment-start))
1964; comment-start "")
1965; )
1966 )
2076c87c
JB
1967 (if (not (eolp))
1968 (setq comment-end ""))
1969 (insert ?\n)
1970 (forward-char -1)
1971 (indent-for-comment)
1972 (save-excursion
1973 ;; Make sure we delete the newline inserted above.
1974 (end-of-line)
1975 (delete-char 1)))
1976 (if fill-prefix
1977 (insert fill-prefix)
1978 (indent-according-to-mode)))))
1979
1980(defun auto-fill-mode (&optional arg)
1981 "Toggle auto-fill mode.
1982With arg, turn auto-fill mode on if and only if arg is positive.
1983In auto-fill mode, inserting a space at a column beyond fill-column
1984automatically breaks the line at a previous space."
1985 (interactive "P")
1986 (prog1 (setq auto-fill-function
1987 (if (if (null arg)
1988 (not auto-fill-function)
1989 (> (prefix-numeric-value arg) 0))
1990 'do-auto-fill
1991 nil))
1992 ;; update mode-line
1993 (set-buffer-modified-p (buffer-modified-p))))
1994
1995(defun turn-on-auto-fill ()
1996 "Unconditionally turn on Auto Fill mode."
1997 (auto-fill-mode 1))
1998
1999(defun set-fill-column (arg)
ff1fbe3e
RS
2000 "Set `fill-column' to current column, or to argument if given.
2001The variable `fill-column' has a separate value for each buffer."
2076c87c
JB
2002 (interactive "P")
2003 (setq fill-column (if (integerp arg) arg (current-column)))
2004 (message "fill-column set to %d" fill-column))
2005\f
2006(defun set-selective-display (arg)
ff1fbe3e
RS
2007 "Set `selective-display' to ARG; clear it if no arg.
2008When the value of `selective-display' is a number > 0,
2009lines whose indentation is >= that value are not displayed.
2010The variable `selective-display' has a separate value for each buffer."
2076c87c
JB
2011 (interactive "P")
2012 (if (eq selective-display t)
2013 (error "selective-display already in use for marked lines"))
c88ab9ce
ER
2014 (let ((current-vpos
2015 (save-restriction
2016 (narrow-to-region (point-min) (point))
2017 (goto-char (window-start))
2018 (vertical-motion (window-height)))))
2019 (setq selective-display
2020 (and arg (prefix-numeric-value arg)))
2021 (recenter current-vpos))
2076c87c
JB
2022 (set-window-start (selected-window) (window-start (selected-window)))
2023 (princ "selective-display set to " t)
2024 (prin1 selective-display t)
2025 (princ "." t))
2026
b6a22db0
JB
2027(defconst overwrite-mode-textual " Ovwrt"
2028 "The string displayed in the mode line when in overwrite mode.")
2029(defconst overwrite-mode-binary " Bin Ovwrt"
2030 "The string displayed in the mode line when in binary overwrite mode.")
2031
2076c87c
JB
2032(defun overwrite-mode (arg)
2033 "Toggle overwrite mode.
2034With arg, turn overwrite mode on iff arg is positive.
2035In overwrite mode, printing characters typed in replace existing text
b6a22db0
JB
2036on a one-for-one basis, rather than pushing it to the right. At the
2037end of a line, such characters extend the line. Before a tab,
2038such characters insert until the tab is filled in.
2039\\[quoted-insert] still inserts characters in overwrite mode; this
2040is supposed to make it easier to insert characters when necessary."
2041 (interactive "P")
2042 (setq overwrite-mode
2043 (if (if (null arg) (not overwrite-mode)
2044 (> (prefix-numeric-value arg) 0))
2045 'overwrite-mode-textual))
2046 (force-mode-line-update))
2047
2048(defun binary-overwrite-mode (arg)
2049 "Toggle binary overwrite mode.
2050With arg, turn binary overwrite mode on iff arg is positive.
2051In binary overwrite mode, printing characters typed in replace
2052existing text. Newlines are not treated specially, so typing at the
2053end of a line joins the line to the next, with the typed character
2054between them. Typing before a tab character simply replaces the tab
2055with the character typed.
2056\\[quoted-insert] replaces the text at the cursor, just as ordinary
2057typing characters do.
2058
2059Note that binary overwrite mode is not its own minor mode; it is a
2060specialization of overwrite-mode, entered by setting the
2061`overwrite-mode' variable to `overwrite-mode-binary'."
2076c87c
JB
2062 (interactive "P")
2063 (setq overwrite-mode
b6a22db0 2064 (if (if (null arg)
a61099dd 2065 (not (eq overwrite-mode 'overwrite-mode-binary))
b6a22db0
JB
2066 (> (prefix-numeric-value arg) 0))
2067 'overwrite-mode-binary))
2068 (force-mode-line-update))
2076c87c 2069\f
a61099dd
RS
2070(defvar line-number-mode nil
2071 "*Non-nil means display line number in mode line.")
2072
2073(defun line-number-mode (arg)
2074 "Toggle Line Number mode.
2075With arg, turn Line Number mode on iff arg is positive.
2076When Line Number mode is enabled, the line number appears
2077in the mode line."
2078 (interactive "P")
2079 (setq line-number-mode
2080 (if (null arg) (not line-number-mode)
2081 (> (prefix-numeric-value arg) 0)))
2082 (force-mode-line-update))
2083
2076c87c
JB
2084(defvar blink-matching-paren t
2085 "*Non-nil means show matching open-paren when close-paren is inserted.")
2086
37315725
RS
2087(defconst blink-matching-paren-distance 12000
2088 "*If non-nil, is maximum distance to search for matching open-paren.")
2076c87c
JB
2089
2090(defun blink-matching-open ()
2091 "Move cursor momentarily to the beginning of the sexp before point."
2092 (interactive)
2093 (and (> (point) (1+ (point-min)))
2094 (/= (char-syntax (char-after (- (point) 2))) ?\\ )
2095 blink-matching-paren
2096 (let* ((oldpos (point))
2097 (blinkpos)
2098 (mismatch))
2099 (save-excursion
2100 (save-restriction
2101 (if blink-matching-paren-distance
2102 (narrow-to-region (max (point-min)
2103 (- (point) blink-matching-paren-distance))
2104 oldpos))
2105 (condition-case ()
2106 (setq blinkpos (scan-sexps oldpos -1))
2107 (error nil)))
2108 (and blinkpos (/= (char-syntax (char-after blinkpos))
2109 ?\$)
2110 (setq mismatch
2111 (/= (char-after (1- oldpos))
2112 (logand (lsh (aref (syntax-table)
2113 (char-after blinkpos))
2114 -8)
2115 255))))
2116 (if mismatch (setq blinkpos nil))
2117 (if blinkpos
2118 (progn
2119 (goto-char blinkpos)
2120 (if (pos-visible-in-window-p)
2121 (sit-for 1)
2122 (goto-char blinkpos)
2123 (message
2124 "Matches %s"
2125 (if (save-excursion
2126 (skip-chars-backward " \t")
2127 (not (bolp)))
2128 (buffer-substring (progn (beginning-of-line) (point))
2129 (1+ blinkpos))
2130 (buffer-substring blinkpos
2131 (progn
2132 (forward-char 1)
2133 (skip-chars-forward "\n \t")
2134 (end-of-line)
2135 (point)))))))
2136 (cond (mismatch
2137 (message "Mismatched parentheses"))
2138 ((not blink-matching-paren-distance)
2139 (message "Unmatched parenthesis"))))))))
2140
2141;Turned off because it makes dbx bomb out.
2142(setq blink-paren-function 'blink-matching-open)
2143
9a1277dd
RS
2144;; This executes C-g typed while Emacs is waiting for a command.
2145;; Quitting out of a program does not go through here;
2146;; that happens in the QUIT macro at the C code level.
2076c87c 2147(defun keyboard-quit ()
af39530e
RS
2148 "Signal a quit condition.
2149During execution of Lisp code, this character causes a quit directly.
2150At top-level, as an editor command, this simply beeps."
2076c87c 2151 (interactive)
66050f10
RS
2152 (and transient-mark-mode mark-active
2153 (progn
2154 (setq mark-active nil)
2155 (run-hooks 'deactivate-mark-hook)))
2076c87c
JB
2156 (signal 'quit nil))
2157
2158(define-key global-map "\C-g" 'keyboard-quit)
2159\f
2160(defun set-variable (var val)
2161 "Set VARIABLE to VALUE. VALUE is a Lisp object.
2162When using this interactively, supply a Lisp expression for VALUE.
3a801d0c
ER
2163If you want VALUE to be a string, you must surround it with doublequotes.
2164
2165If VARIABLE has a `variable-interactive' property, that is used as if
2166it were the arg to `interactive' (which see) to interactively read the value."
2076c87c
JB
2167 (interactive
2168 (let* ((var (read-variable "Set variable: "))
2169 (minibuffer-help-form
2170 '(funcall myhelp))
2171 (myhelp
2172 (function
2173 (lambda ()
2174 (with-output-to-temp-buffer "*Help*"
2175 (prin1 var)
2176 (princ "\nDocumentation:\n")
2177 (princ (substring (documentation-property var 'variable-documentation)
2178 1))
2179 (if (boundp var)
2180 (let ((print-length 20))
2181 (princ "\n\nCurrent value: ")
2182 (prin1 (symbol-value var))))
2183 nil)))))
2184 (list var
3a801d0c
ER
2185 (let ((prop (get var 'variable-interactive)))
2186 (if prop
2187 ;; Use VAR's `variable-interactive' property
2188 ;; as an interactive spec for prompting.
2189 (call-interactively (list 'lambda '(arg)
2190 (list 'interactive prop)
2191 'arg))
2192 (eval-minibuffer (format "Set %s to value: " var)))))))
2076c87c 2193 (set var val))
c88ab9ce 2194
a3d1480b
JB
2195\f
2196;;;; Keypad support.
2197
2198;;; Make the keypad keys act like ordinary typing keys. If people add
2199;;; bindings for the function key symbols, then those bindings will
2200;;; override these, so this shouldn't interfere with any existing
2201;;; bindings.
2202
2203(mapcar
2204 (lambda (keypad-normal)
2205 (let ((keypad (nth 0 keypad-normal))
2206 (normal (nth 1 keypad-normal)))
2207 (define-key function-key-map (vector keypad) (vector normal))))
2208 '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
2209 (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
2210 (kp-space ?\ )
2211 (kp-tab ?\t)
2212 (kp-enter ?\r)
2213 (kp-multiply ?*)
2214 (kp-add ?+)
2215 (kp-separator ?,)
2216 (kp-subtract ?-)
2217 (kp-decimal ?.)
2218 (kp-divide ?/)
2219 (kp-equal ?=)))
2220
c88ab9ce 2221;;; simple.el ends here