(set-visited-file-name): Rename auto-save file only if it exists.
[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.
109d300c 1043 (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100)))
70e14c01
JB
1044 (delete-region beg end)
1045 ;; Take the same string recorded for undo
1046 ;; and put it in the kill-ring.
1047 (kill-new (car (car buffer-undo-list)))
1048 (setq this-command 'kill-region)))
2aa7a8bf 1049
70e14c01 1050 (t
2076c87c 1051 (copy-region-as-kill beg end)
70e14c01 1052 (delete-region beg end))))
2076c87c 1053
2076c87c
JB
1054(defun copy-region-as-kill (beg end)
1055 "Save the region as if killed, but don't kill it.
46947372
JB
1056If `interprogram-cut-function' is non-nil, also save the text for a window
1057system cut and paste."
2076c87c
JB
1058 (interactive "r")
1059 (if (eq last-command 'kill-region)
1060 (kill-append (buffer-substring beg end) (< end beg))
70e14c01
JB
1061 (kill-new (buffer-substring beg end)))
1062 (setq this-command 'kill-region)
2076c87c
JB
1063 nil)
1064
1065(defun kill-ring-save (beg end)
0964e562 1066 "Save the region as if killed, but don't kill it.
230c6b36 1067This command is similar to `copy-region-as-kill', except that it gives
0964e562
JB
1068visual feedback indicating the extent of the region being copied.
1069If `interprogram-cut-function' is non-nil, also save the text for a window
1070system cut and paste."
2076c87c
JB
1071 (interactive "r")
1072 (copy-region-as-kill beg end)
3a801d0c 1073 (if (interactive-p)
66050f10
RS
1074 (let ((other-end (if (= (point) beg) end beg))
1075 (opoint (point))
1076 ;; Inhibit quitting so we can make a quit here
1077 ;; look like a C-g typed as a command.
1078 (inhibit-quit t))
1079 (if (pos-visible-in-window-p other-end (selected-window))
1080 (progn
1081 ;; Swap point and mark.
1082 (set-marker (mark-marker) (point) (current-buffer))
1083 (goto-char other-end)
1084 (sit-for 1)
1085 ;; Swap back.
1086 (set-marker (mark-marker) other-end (current-buffer))
1087 (goto-char opoint)
1088 ;; If user quit, deactivate the mark
1089 ;; as C-g would as a command.
1090 (and quit-flag transient-mark-mode mark-active
1091 (progn
1092 (message "foo")
1093 (setq mark-active nil)
1094 (run-hooks 'deactivate-mark-hook))))
1095 (let* ((killed-text (current-kill 0))
1096 (message-len (min (length killed-text) 40)))
1097 (if (= (point) beg)
1098 ;; Don't say "killed"; that is misleading.
1099 (message "Saved text until \"%s\""
1100 (substring killed-text (- message-len)))
1101 (message "Saved text from \"%s\""
1102 (substring killed-text 0 message-len))))))))
2076c87c
JB
1103
1104(defun append-next-kill ()
ff1fbe3e 1105 "Cause following command, if it kills, to append to previous kill."
2076c87c
JB
1106 (interactive)
1107 (if (interactive-p)
1108 (progn
1109 (setq this-command 'kill-region)
1110 (message "If the next command is a kill, it will append"))
1111 (setq last-command 'kill-region)))
1112
2076c87c 1113(defun yank-pop (arg)
ff1fbe3e
RS
1114 "Replace just-yanked stretch of killed text with a different stretch.
1115This command is allowed only immediately after a `yank' or a `yank-pop'.
2076c87c 1116At such a time, the region contains a stretch of reinserted
ff1fbe3e 1117previously-killed text. `yank-pop' deletes that text and inserts in its
2076c87c
JB
1118place a different stretch of killed text.
1119
1120With no argument, the previous kill is inserted.
ff1fbe3e
RS
1121With argument N, insert the Nth previous kill.
1122If N is negative, this is a more recent kill.
2076c87c
JB
1123
1124The sequence of kills wraps around, so that after the oldest one
1125comes the newest one."
1126 (interactive "*p")
1127 (if (not (eq last-command 'yank))
1128 (error "Previous command was not a yank"))
1129 (setq this-command 'yank)
9a1277dd
RS
1130 (let ((before (< (point) (mark t))))
1131 (delete-region (point) (mark t))
fd0f4056 1132 (set-marker (mark-marker) (point) (current-buffer))
70e14c01 1133 (insert (current-kill arg))
fd0f4056
RS
1134 (if before
1135 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
1136 ;; It is cleaner to avoid activation, even though the command
1137 ;; loop would deactivate the mark because we inserted text.
1138 (goto-char (prog1 (mark t)
1139 (set-marker (mark-marker) (point) (current-buffer))))))
0964e562 1140 nil)
2076c87c
JB
1141
1142(defun yank (&optional arg)
1143 "Reinsert the last stretch of killed text.
1144More precisely, reinsert the stretch of killed text most recently
ff1fbe3e
RS
1145killed OR yanked. Put point at end, and set mark at beginning.
1146With just C-u as argument, same but put point at beginning (and mark at end).
1147With argument N, reinsert the Nth most recently killed stretch of killed
2076c87c
JB
1148text.
1149See also the command \\[yank-pop]."
1150 (interactive "*P")
2076c87c 1151 (push-mark (point))
70e14c01
JB
1152 (insert (current-kill (cond
1153 ((listp arg) 0)
1154 ((eq arg '-) -1)
1155 (t (1- arg)))))
2076c87c 1156 (if (consp arg)
fd0f4056
RS
1157 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
1158 ;; It is cleaner to avoid activation, even though the command
1159 ;; loop would deactivate the mark because we inserted text.
1160 (goto-char (prog1 (mark t)
1161 (set-marker (mark-marker) (point) (current-buffer)))))
0964e562 1162 nil)
70e14c01
JB
1163
1164(defun rotate-yank-pointer (arg)
1165 "Rotate the yanking point in the kill ring.
1166With argument, rotate that many kills forward (or backward, if negative)."
1167 (interactive "p")
1168 (current-kill arg))
1169
2076c87c
JB
1170\f
1171(defun insert-buffer (buffer)
1172 "Insert after point the contents of BUFFER.
1173Puts mark after the inserted text.
1174BUFFER may be a buffer or a buffer name."
58ff020d
RS
1175 (interactive (list (progn (barf-if-buffer-read-only)
1176 (read-buffer "Insert buffer: " (other-buffer) t))))
2076c87c
JB
1177 (or (bufferp buffer)
1178 (setq buffer (get-buffer buffer)))
1179 (let (start end newmark)
1180 (save-excursion
1181 (save-excursion
1182 (set-buffer buffer)
1183 (setq start (point-min) end (point-max)))
1184 (insert-buffer-substring buffer start end)
1185 (setq newmark (point)))
1537a263
JB
1186 (push-mark newmark))
1187 nil)
2076c87c
JB
1188
1189(defun append-to-buffer (buffer start end)
1190 "Append to specified buffer the text of the region.
1191It is inserted into that buffer before its point.
1192
1193When calling from a program, give three arguments:
1194BUFFER (or buffer name), START and END.
1195START and END specify the portion of the current buffer to be copied."
70e14c01 1196 (interactive
23efee2c
RS
1197 (list (read-buffer "Append to buffer: " (other-buffer nil t))
1198 (region-beginning) (region-end)))
2076c87c
JB
1199 (let ((oldbuf (current-buffer)))
1200 (save-excursion
1201 (set-buffer (get-buffer-create buffer))
1202 (insert-buffer-substring oldbuf start end))))
1203
1204(defun prepend-to-buffer (buffer start end)
1205 "Prepend to specified buffer the text of the region.
1206It is inserted into that buffer after its point.
1207
1208When calling from a program, give three arguments:
1209BUFFER (or buffer name), START and END.
1210START and END specify the portion of the current buffer to be copied."
1211 (interactive "BPrepend to buffer: \nr")
1212 (let ((oldbuf (current-buffer)))
1213 (save-excursion
1214 (set-buffer (get-buffer-create buffer))
1215 (save-excursion
1216 (insert-buffer-substring oldbuf start end)))))
1217
1218(defun copy-to-buffer (buffer start end)
1219 "Copy to specified buffer the text of the region.
1220It is inserted into that buffer, replacing existing text there.
1221
1222When calling from a program, give three arguments:
1223BUFFER (or buffer name), START and END.
1224START and END specify the portion of the current buffer to be copied."
1225 (interactive "BCopy to buffer: \nr")
1226 (let ((oldbuf (current-buffer)))
1227 (save-excursion
1228 (set-buffer (get-buffer-create buffer))
1229 (erase-buffer)
1230 (save-excursion
1231 (insert-buffer-substring oldbuf start end)))))
1232\f
0bf0c097
RS
1233(defvar mark-even-if-inactive nil
1234 "*Non-nil means you can use the mark even when inactive.
1235This option makes a difference in Transient Mark mode.
1236When the option is non-nil, deactivation of the mark
1237turns off region highlighting, but commands that use the mark
1238behave as if the mark were still active.")
1239
af39530e 1240(defun mark (&optional force)
c7c8b31e 1241 "Return this buffer's mark value as integer; error if mark inactive.
af39530e 1242If optional argument FORCE is non-nil, access the mark value
c7c8b31e
RS
1243even if the mark is not currently active, and return nil
1244if there is no mark at all.
af39530e 1245
2076c87c
JB
1246If you are using this in an editing command, you are most likely making
1247a mistake; see the documentation of `set-mark'."
0bf0c097 1248 (if (or force mark-active mark-even-if-inactive)
af39530e
RS
1249 (marker-position (mark-marker))
1250 (error "The mark is not currently active")))
2076c87c
JB
1251
1252(defun set-mark (pos)
1253 "Set this buffer's mark to POS. Don't use this function!
1254That is to say, don't use this function unless you want
1255the user to see that the mark has moved, and you want the previous
1256mark position to be lost.
1257
1258Normally, when a new mark is set, the old one should go on the stack.
1259This is why most applications should use push-mark, not set-mark.
1260
ff1fbe3e 1261Novice Emacs Lisp programmers often try to use the mark for the wrong
2076c87c
JB
1262purposes. The mark saves a location for the user's convenience.
1263Most editing commands should not alter the mark.
1264To remember a location for internal use in the Lisp program,
1265store it in a Lisp variable. Example:
1266
1267 (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
1268
af39530e
RS
1269 (setq mark-active t)
1270 (run-hooks 'activate-mark-hook)
2076c87c
JB
1271 (set-marker (mark-marker) pos (current-buffer)))
1272
1273(defvar mark-ring nil
1274 "The list of saved former marks of the current buffer,
1275most recent first.")
1276(make-variable-buffer-local 'mark-ring)
1277
1278(defconst mark-ring-max 16
1279 "*Maximum size of mark ring. Start discarding off end if gets this big.")
1280
1281(defun set-mark-command (arg)
1282 "Set mark at where point is, or jump to mark.
79926889
JB
1283With no prefix argument, set mark, and push old mark position on mark ring.
1284With argument, jump to mark, and pop a new position for mark off the ring.
2076c87c 1285
ff1fbe3e 1286Novice Emacs Lisp programmers often try to use the mark for the wrong
2076c87c
JB
1287purposes. See the documentation of `set-mark' for more information."
1288 (interactive "P")
1289 (if (null arg)
9a1277dd 1290 (progn
fd0f4056 1291 (push-mark nil nil t))
af39530e 1292 (if (null (mark t))
2076c87c 1293 (error "No mark set in this buffer")
9a1277dd 1294 (goto-char (mark t))
2076c87c
JB
1295 (pop-mark))))
1296
fd0f4056 1297(defun push-mark (&optional location nomsg activate)
2076c87c 1298 "Set mark at LOCATION (point, by default) and push old mark on mark ring.
fd0f4056 1299Display `Mark set' unless the optional second arg NOMSG is non-nil.
8cdc660f 1300In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil.
2076c87c 1301
ff1fbe3e 1302Novice Emacs Lisp programmers often try to use the mark for the wrong
9a1277dd
RS
1303purposes. See the documentation of `set-mark' for more information.
1304
1305In Transient Mark mode, this does not activate the mark."
af39530e 1306 (if (null (mark t))
2076c87c
JB
1307 nil
1308 (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
1309 (if (> (length mark-ring) mark-ring-max)
1310 (progn
1311 (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
1312 (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
9a1277dd 1313 (set-marker (mark-marker) (or location (point)) (current-buffer))
2076c87c
JB
1314 (or nomsg executing-macro (> (minibuffer-depth) 0)
1315 (message "Mark set"))
8cdc660f
RS
1316 (if (or activate (not transient-mark-mode))
1317 (set-mark (mark t)))
2076c87c
JB
1318 nil)
1319
1320(defun pop-mark ()
1321 "Pop off mark ring into the buffer's actual mark.
1322Does not set point. Does nothing if mark ring is empty."
1323 (if mark-ring
1324 (progn
1325 (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
9a1277dd
RS
1326 (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
1327 (if transient-mark-mode
1328 (setq mark-active nil))
2076c87c 1329 (move-marker (car mark-ring) nil)
9a1277dd 1330 (if (null (mark t)) (ding))
2076c87c
JB
1331 (setq mark-ring (cdr mark-ring)))))
1332
dff7d67f 1333(define-function 'exchange-dot-and-mark 'exchange-point-and-mark)
2076c87c 1334(defun exchange-point-and-mark ()
af39530e
RS
1335 "Put the mark where point is now, and point where the mark is now.
1336This command works even when the mark is not active,
1337and it reactivates the mark."
2076c87c 1338 (interactive nil)
af39530e 1339 (let ((omark (mark t)))
2076c87c
JB
1340 (if (null omark)
1341 (error "No mark set in this buffer"))
1342 (set-mark (point))
1343 (goto-char omark)
1344 nil))
e23c2c21
RS
1345
1346(defun transient-mark-mode (arg)
1347 "Toggle Transient Mark mode.
b411b5fa 1348With arg, turn Transient Mark mode on if arg is positive, off otherwise.
e23c2c21
RS
1349
1350In Transient Mark mode, changing the buffer \"deactivates\" the mark.
1351While the mark is active, the region is highlighted."
1352 (interactive "P")
1353 (setq transient-mark-mode
1354 (if (null arg)
1355 (not transient-mark-mode)
1356 (> (prefix-numeric-value arg) 0))))
2076c87c 1357\f
38ebcf29 1358(defvar next-line-add-newlines t
dff7d67f 1359 "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error.")
38ebcf29 1360
2076c87c
JB
1361(defun next-line (arg)
1362 "Move cursor vertically down ARG lines.
1363If there is no character in the target line exactly under the current column,
1364the cursor is positioned after the character in that line which spans this
1365column, or at the end of the line if it is not long enough.
38ebcf29
ER
1366If there is no line in the buffer after this one, behavior depends on the
1367value of next-line-add-newlines. If non-nil, a newline character is inserted
1368to create a line and the cursor moves to that line, otherwise the cursor is
1369moved to the end of the buffer (if already at the end of the buffer, an error
1370is signaled).
2076c87c
JB
1371
1372The command \\[set-goal-column] can be used to create
1373a semipermanent goal column to which this command always moves.
1374Then it does not try to move vertically. This goal column is stored
1375in `goal-column', which is nil when there is none.
1376
1377If you are thinking of using this in a Lisp program, consider
1378using `forward-line' instead. It is usually easier to use
1379and more reliable (no dependence on goal column, etc.)."
1380 (interactive "p")
38ebcf29
ER
1381 (let ((opoint (point)))
1382 (if next-line-add-newlines
1383 (if (/= arg 1)
1384 (line-move arg)
1385 (forward-line 1)
1386 (if (or (= opoint (point)) (not (eq (preceding-char) ?\n)))
1387 (insert ?\n)
1388 (goto-char opoint)
1389 (line-move arg)))
1390 (if (eobp)
1391 (signal 'end-of-buffer nil))
1392 (line-move arg)
1393 (if (= opoint (point))
1394 (end-of-line))))
2076c87c
JB
1395 nil)
1396
1397(defun previous-line (arg)
1398 "Move cursor vertically up ARG lines.
1399If there is no character in the target line exactly over the current column,
1400the cursor is positioned after the character in that line which spans this
1401column, or at the end of the line if it is not long enough.
1402
1403The command \\[set-goal-column] can be used to create
1404a semipermanent goal column to which this command always moves.
1405Then it does not try to move vertically.
1406
1407If you are thinking of using this in a Lisp program, consider using
c2e8a012 1408`forward-line' with a negative argument instead. It is usually easier
2076c87c
JB
1409to use and more reliable (no dependence on goal column, etc.)."
1410 (interactive "p")
1411 (line-move (- arg))
1412 nil)
1413
1414(defconst track-eol nil
1415 "*Non-nil means vertical motion starting at end of line keeps to ends of lines.
1416This means moving to the end of each line moved onto.
1417The beginning of a blank line does not count as the end of a line.")
1418
912c6728
RS
1419(defvar goal-column nil
1420 "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil.")
1421(make-variable-buffer-local 'goal-column)
2076c87c
JB
1422
1423(defvar temporary-goal-column 0
1424 "Current goal column for vertical motion.
1425It is the column where point was
1426at the start of current run of vertical motion commands.
c637ae6f 1427When the `track-eol' feature is doing its job, the value is 9999.")
2076c87c
JB
1428
1429(defun line-move (arg)
1430 (if (not (or (eq last-command 'next-line)
1431 (eq last-command 'previous-line)))
1432 (setq temporary-goal-column
1433 (if (and track-eol (eolp)
1434 ;; Don't count beg of empty line as end of line
1435 ;; unless we just did explicit end-of-line.
1436 (or (not (bolp)) (eq last-command 'end-of-line)))
1437 9999
1438 (current-column))))
1439 (if (not (integerp selective-display))
1440 (forward-line arg)
1441 ;; Move by arg lines, but ignore invisible ones.
1442 (while (> arg 0)
1443 (vertical-motion 1)
1444 (forward-char -1)
1445 (forward-line 1)
1446 (setq arg (1- arg)))
1447 (while (< arg 0)
1448 (vertical-motion -1)
1449 (beginning-of-line)
1450 (setq arg (1+ arg))))
1451 (move-to-column (or goal-column temporary-goal-column))
1452 nil)
1453
d5ab2033
JB
1454;;; Many people have said they rarely use this feature, and often type
1455;;; it by accident. Maybe it shouldn't even be on a key.
1456(put 'set-goal-column 'disabled t)
2076c87c
JB
1457
1458(defun set-goal-column (arg)
1459 "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
1460Those commands will move to this position in the line moved to
1461rather than trying to keep the same horizontal position.
1462With a non-nil argument, clears out the goal column
912c6728
RS
1463so that \\[next-line] and \\[previous-line] resume vertical motion.
1464The goal column is stored in the variable `goal-column'."
2076c87c
JB
1465 (interactive "P")
1466 (if arg
1467 (progn
1468 (setq goal-column nil)
1469 (message "No goal column"))
1470 (setq goal-column (current-column))
1471 (message (substitute-command-keys
1472 "Goal column %d (use \\[set-goal-column] with an arg to unset it)")
1473 goal-column))
1474 nil)
1475\f
0d5bbbf7
ER
1476;;; Partial support for horizontal autoscrolling. Someday, this feature
1477;;; will be built into the C level and all the (hscroll-point-visible) calls
1478;;; will go away.
1479
1480(defvar hscroll-step 0
1481 "*The number of columns to try scrolling a window by when point moves out.
1482If that fails to bring point back on frame, point is centered instead.
1483If this is zero, point is always centered after it moves off frame.")
1484
1485(defun hscroll-point-visible ()
1486 "Scrolls the window horizontally to make point visible."
1f3696d7
JB
1487 (let* ((here (current-column))
1488 (left (window-hscroll))
1489 (right (- (+ left (window-width)) 3)))
1490 (cond
1491 ;; Should we recenter?
1492 ((or (< here (- left hscroll-step))
1493 (> here (+ right hscroll-step)))
1494 (set-window-hscroll
1495 (selected-window)
1496 ;; Recenter, but don't show too much white space off the end of
1497 ;; the line.
1498 (max 0
1499 (min (- (save-excursion (end-of-line) (current-column))
1500 (window-width)
1501 -5)
1502 (- here (/ (window-width) 2))))))
1503 ;; Should we scroll left?
1504 ((> here right)
1505 (scroll-left hscroll-step))
1506 ;; Or right?
1507 ((< here left)
1508 (scroll-right hscroll-step)))))
0d5bbbf7 1509
dff7d67f
RS
1510;; rms: (1) The definitions of arrow keys should not simply restate
1511;; what keys they are. The arrow keys should run the ordinary commands.
1512;; (2) The arrow keys are just one of many common ways of moving point
1513;; within a line. Real horizontal autoscrolling would be a good feature,
1514;; but supporting it only for arrow keys is too incomplete to be desirable.
1515
1516;;;;; Make arrow keys do the right thing for improved terminal support
1517;;;;; When we implement true horizontal autoscrolling, right-arrow and
1518;;;;; left-arrow can lose the (if truncate-lines ...) clause and become
1519;;;;; aliases. These functions are bound to the corresponding keyboard
1520;;;;; events in loaddefs.el.
1521
1522;;(defun right-arrow (arg)
1523;; "Move right one character on the screen (with prefix ARG, that many chars).
1524;;Scroll right if needed to keep point horizontally onscreen."
1525;; (interactive "P")
1526;; (forward-char arg)
1527;; (hscroll-point-visible))
1528
1529;;(defun left-arrow (arg)
1530;; "Move left one character on the screen (with prefix ARG, that many chars).
1531;;Scroll left if needed to keep point horizontally onscreen."
1532;; (interactive "P")
1533;; (backward-char arg)
1534;; (hscroll-point-visible))
38ebcf29 1535\f
2076c87c
JB
1536(defun transpose-chars (arg)
1537 "Interchange characters around point, moving forward one character.
1538With prefix arg ARG, effect is to take character before point
1539and drag it forward past ARG other characters (backward if ARG negative).
1540If no argument and at end of line, the previous two chars are exchanged."
1541 (interactive "*P")
1542 (and (null arg) (eolp) (forward-char -1))
1543 (transpose-subr 'forward-char (prefix-numeric-value arg)))
1544
1545(defun transpose-words (arg)
1546 "Interchange words around point, leaving point at end of them.
1547With prefix arg ARG, effect is to take word before or around point
1548and drag it forward past ARG other words (backward if ARG negative).
1549If ARG is zero, the words around or after point and around or after mark
1550are interchanged."
1551 (interactive "*p")
1552 (transpose-subr 'forward-word arg))
1553
1554(defun transpose-sexps (arg)
1555 "Like \\[transpose-words] but applies to sexps.
1556Does not work on a sexp that point is in the middle of
1557if it is a list or string."
1558 (interactive "*p")
1559 (transpose-subr 'forward-sexp arg))
1560
1561(defun transpose-lines (arg)
1562 "Exchange current line and previous line, leaving point after both.
1563With argument ARG, takes previous line and moves it past ARG lines.
1564With argument 0, interchanges line point is in with line mark is in."
1565 (interactive "*p")
1566 (transpose-subr (function
1567 (lambda (arg)
1568 (if (= arg 1)
1569 (progn
1570 ;; Move forward over a line,
1571 ;; but create a newline if none exists yet.
1572 (end-of-line)
1573 (if (eobp)
1574 (newline)
1575 (forward-char 1)))
1576 (forward-line arg))))
1577 arg))
1578
1579(defun transpose-subr (mover arg)
1580 (let (start1 end1 start2 end2)
1581 (if (= arg 0)
1582 (progn
1583 (save-excursion
1584 (funcall mover 1)
1585 (setq end2 (point))
1586 (funcall mover -1)
1587 (setq start2 (point))
1588 (goto-char (mark))
1589 (funcall mover 1)
1590 (setq end1 (point))
1591 (funcall mover -1)
1592 (setq start1 (point))
1593 (transpose-subr-1))
1594 (exchange-point-and-mark)))
1595 (while (> arg 0)
1596 (funcall mover -1)
1597 (setq start1 (point))
1598 (funcall mover 1)
1599 (setq end1 (point))
1600 (funcall mover 1)
1601 (setq end2 (point))
1602 (funcall mover -1)
1603 (setq start2 (point))
1604 (transpose-subr-1)
1605 (goto-char end2)
1606 (setq arg (1- arg)))
1607 (while (< arg 0)
1608 (funcall mover -1)
1609 (setq start2 (point))
1610 (funcall mover -1)
1611 (setq start1 (point))
1612 (funcall mover 1)
1613 (setq end1 (point))
1614 (funcall mover 1)
1615 (setq end2 (point))
1616 (transpose-subr-1)
1617 (setq arg (1+ arg)))))
1618
1619(defun transpose-subr-1 ()
1620 (if (> (min end1 end2) (max start1 start2))
1621 (error "Don't have two things to transpose"))
1622 (let ((word1 (buffer-substring start1 end1))
1623 (word2 (buffer-substring start2 end2)))
1624 (delete-region start2 end2)
1625 (goto-char start2)
1626 (insert word1)
1627 (goto-char (if (< start1 start2) start1
1628 (+ start1 (- (length word1) (length word2)))))
1629 (delete-char (length word1))
1630 (insert word2)))
1631\f
1632(defconst comment-column 32
1633 "*Column to indent right-margin comments to.
8a8fa723
JB
1634Setting this variable automatically makes it local to the current buffer.
1635Each mode establishes a different default value for this variable; you
1636can the value for a particular mode using that mode's hook.")
2076c87c
JB
1637(make-variable-buffer-local 'comment-column)
1638
1639(defconst comment-start nil
1640 "*String to insert to start a new comment, or nil if no comment syntax defined.")
1641
1642(defconst comment-start-skip nil
1643 "*Regexp to match the start of a comment plus everything up to its body.
1644If there are any \\(...\\) pairs, the comment delimiter text is held to begin
1645at the place matched by the close of the first pair.")
1646
1647(defconst comment-end ""
1648 "*String to insert to end a new comment.
1649Should be an empty string if comments are terminated by end-of-line.")
1650
ec9a76e3
JB
1651(defconst comment-indent-hook nil
1652 "Obsolete variable for function to compute desired indentation for a comment.
1653This function is called with no args with point at the beginning of
1654the comment's starting delimiter.")
1655
1656(defconst comment-indent-function
2076c87c
JB
1657 '(lambda () comment-column)
1658 "Function to compute desired indentation for a comment.
1659This function is called with no args with point at the beginning of
1660the comment's starting delimiter.")
1661
1662(defun indent-for-comment ()
1663 "Indent this line's comment to comment column, or insert an empty comment."
1664 (interactive "*")
1665 (beginning-of-line 1)
1666 (if (null comment-start)
1667 (error "No comment syntax defined")
1668 (let* ((eolpos (save-excursion (end-of-line) (point)))
1669 cpos indent begpos)
1670 (if (re-search-forward comment-start-skip eolpos 'move)
1671 (progn (setq cpos (point-marker))
1672 ;; Find the start of the comment delimiter.
1673 ;; If there were paren-pairs in comment-start-skip,
1674 ;; position at the end of the first pair.
1675 (if (match-end 1)
1676 (goto-char (match-end 1))
9d0f559a
RM
1677 ;; If comment-start-skip matched a string with
1678 ;; internal whitespace (not final whitespace) then
1679 ;; the delimiter start at the end of that
1680 ;; whitespace. Otherwise, it starts at the
1681 ;; beginning of what was matched.
1682 (skip-syntax-backward " " (match-beginning 0))
1683 (skip-syntax-backward "^ " (match-beginning 0)))))
2076c87c
JB
1684 (setq begpos (point))
1685 ;; Compute desired indent.
1686 (if (= (current-column)
9d0f559a
RM
1687 (setq indent (if comment-indent-hook
1688 (funcall comment-indent-hook)
1689 (funcall comment-indent-function))))
2076c87c
JB
1690 (goto-char begpos)
1691 ;; If that's different from current, change it.
1692 (skip-chars-backward " \t")
1693 (delete-region (point) begpos)
1694 (indent-to indent))
1695 ;; An existing comment?
1696 (if cpos
1697 (progn (goto-char cpos)
1698 (set-marker cpos nil))
1699 ;; No, insert one.
1700 (insert comment-start)
1701 (save-excursion
1702 (insert comment-end))))))
1703
1704(defun set-comment-column (arg)
1705 "Set the comment column based on point.
1706With no arg, set the comment column to the current column.
1707With just minus as arg, kill any comment on this line.
1708With any other arg, set comment column to indentation of the previous comment
1709 and then align or create a comment on this line at that column."
1710 (interactive "P")
1711 (if (eq arg '-)
1712 (kill-comment nil)
1713 (if arg
1714 (progn
1715 (save-excursion
1716 (beginning-of-line)
1717 (re-search-backward comment-start-skip)
1718 (beginning-of-line)
1719 (re-search-forward comment-start-skip)
1720 (goto-char (match-beginning 0))
1721 (setq comment-column (current-column))
1722 (message "Comment column set to %d" comment-column))
1723 (indent-for-comment))
1724 (setq comment-column (current-column))
1725 (message "Comment column set to %d" comment-column))))
1726
1727(defun kill-comment (arg)
1728 "Kill the comment on this line, if any.
1729With argument, kill comments on that many lines starting with this one."
1730 ;; this function loses in a lot of situations. it incorrectly recognises
1731 ;; comment delimiters sometimes (ergo, inside a string), doesn't work
1732 ;; with multi-line comments, can kill extra whitespace if comment wasn't
1733 ;; through end-of-line, et cetera.
1734 (interactive "P")
1735 (or comment-start-skip (error "No comment syntax defined"))
1736 (let ((count (prefix-numeric-value arg)) endc)
1737 (while (> count 0)
1738 (save-excursion
1739 (end-of-line)
1740 (setq endc (point))
1741 (beginning-of-line)
1742 (and (string< "" comment-end)
1743 (setq endc
1744 (progn
1745 (re-search-forward (regexp-quote comment-end) endc 'move)
1746 (skip-chars-forward " \t")
1747 (point))))
1748 (beginning-of-line)
1749 (if (re-search-forward comment-start-skip endc t)
1750 (progn
1751 (goto-char (match-beginning 0))
1752 (skip-chars-backward " \t")
1753 (kill-region (point) endc)
1754 ;; to catch comments a line beginnings
1755 (indent-according-to-mode))))
1756 (if arg (forward-line 1))
1757 (setq count (1- count)))))
1758
1759(defun comment-region (beg end &optional arg)
1760 "Comment the region; third arg numeric means use ARG comment characters.
1761If ARG is negative, delete that many comment characters instead.
1762Comments are terminated on each line, even for syntax in which newline does
1763not end the comment. Blank lines do not get comments."
1764 ;; if someone wants it to only put a comment-start at the beginning and
1765 ;; comment-end at the end then typing it, C-x C-x, closing it, C-x C-x
1766 ;; is easy enough. No option is made here for other than commenting
1767 ;; every line.
1768 (interactive "r\np")
1769 (or comment-start (error "No comment syntax is defined"))
1770 (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
1771 (save-excursion
1772 (save-restriction
1773 (let ((cs comment-start) (ce comment-end))
1774 (cond ((not arg) (setq arg 1))
1775 ((> arg 1)
1776 (while (> (setq arg (1- arg)) 0)
1777 (setq cs (concat cs comment-start)
1778 ce (concat ce comment-end)))))
1779 (narrow-to-region beg end)
1780 (goto-char beg)
1781 (while (not (eobp))
1782 (if (< arg 0)
1783 (let ((count arg))
1784 (while (and (> 1 (setq count (1+ count)))
1785 (looking-at (regexp-quote cs)))
1786 (delete-char (length cs)))
1787 (if (string= "" ce) ()
1788 (setq count arg)
1789 (while (> 1 (setq count (1+ count)))
1790 (end-of-line)
1791 ;; this is questionable if comment-end ends in whitespace
1792 ;; that is pretty brain-damaged though
1793 (skip-chars-backward " \t")
1794 (backward-char (length ce))
1795 (if (looking-at (regexp-quote ce))
6e88ed49
RS
1796 (delete-char (length ce)))))
1797 (forward-line 1))
2076c87c
JB
1798 (if (looking-at "[ \t]*$") ()
1799 (insert cs)
1800 (if (string= "" ce) ()
1801 (end-of-line)
1802 (insert ce)))
1803 (search-forward "\n" nil 'move)))))))
1804\f
1805(defun backward-word (arg)
1806 "Move backward until encountering the end of a word.
1807With argument, do this that many times.
ff1fbe3e 1808In programs, it is faster to call `forward-word' with negative arg."
2076c87c
JB
1809 (interactive "p")
1810 (forward-word (- arg)))
1811
1812(defun mark-word (arg)
1813 "Set mark arg words away from point."
1814 (interactive "p")
1815 (push-mark
1816 (save-excursion
1817 (forward-word arg)
fd0f4056
RS
1818 (point))
1819 nil t))
2076c87c
JB
1820
1821(defun kill-word (arg)
1822 "Kill characters forward until encountering the end of a word.
1823With argument, do this that many times."
1824 (interactive "p")
01b8e020 1825 (kill-region (point) (save-excursion (forward-word arg) (point))))
2076c87c
JB
1826
1827(defun backward-kill-word (arg)
1828 "Kill characters backward until encountering the end of a word.
1829With argument, do this that many times."
1830 (interactive "p")
1831 (kill-word (- arg)))
d7c64071
ER
1832
1833(defun current-word ()
1834 "Return the word point is on as a string, if it's between two
1835word-constituent characters. If not, but it immediately follows one,
1836move back first. Otherwise, if point precedes a word constituent,
1837move forward first. Otherwise, move backwards until a word constituent
1838is found and get that word; if you reach a newline first, move forward
1839instead."
1840 (interactive)
1841 (save-excursion
1842 (let ((oldpoint (point)) (start (point)) (end (point)))
1843 (skip-syntax-backward "w_") (setq start (point))
1844 (goto-char oldpoint)
1845 (skip-syntax-forward "w_") (setq end (point))
1846 (if (and (eq start oldpoint) (eq end oldpoint))
1847 (progn
1848 (skip-syntax-backward "^w_"
1849 (save-excursion (beginning-of-line) (point)))
1850 (if (eq (preceding-char) ?\n)
1851 (progn
1852 (skip-syntax-forward "^w_")
1853 (setq start (point))
1854 (skip-syntax-forward "w_")
1855 (setq end (point)))
1856 (setq end (point))
1857 (skip-syntax-backward "w_")
1858 (setq start (point)))))
1859 (buffer-substring start end))))
2076c87c
JB
1860\f
1861(defconst fill-prefix nil
1862 "*String for filling to insert at front of new line, or nil for none.
1863Setting this variable automatically makes it local to the current buffer.")
1864(make-variable-buffer-local 'fill-prefix)
1865
1866(defconst auto-fill-inhibit-regexp nil
1867 "*Regexp to match lines which should not be auto-filled.")
1868
1869(defun do-auto-fill ()
1870 (let (give-up)
1871 (or (and auto-fill-inhibit-regexp
1872 (save-excursion (beginning-of-line)
1873 (looking-at auto-fill-inhibit-regexp)))
1874 (while (and (not give-up) (> (current-column) fill-column))
1875 (let ((fill-point
1876 (let ((opoint (point)))
1877 (save-excursion
1878 (move-to-column (1+ fill-column))
1879 (skip-chars-backward "^ \t\n")
1880 (if (bolp)
1881 (re-search-forward "[ \t]" opoint t))
1882 (skip-chars-backward " \t")
1883 (point)))))
1884 ;; If there is a space on the line before fill-point,
1885 ;; and nonspaces precede it, break the line there.
1886 (if (save-excursion
1887 (goto-char fill-point)
1888 (not (bolp)))
1889 ;; If point is at the fill-point, do not `save-excursion'.
1890 ;; Otherwise, if a comment prefix or fill-prefix is inserted,
1891 ;; point will end up before it rather than after it.
1892 (if (save-excursion
1893 (skip-chars-backward " \t")
1894 (= (point) fill-point))
1895 (indent-new-comment-line)
1896 (save-excursion
1897 (goto-char fill-point)
1898 (indent-new-comment-line)))
1899 ;; No place to break => stop trying.
1900 (setq give-up t)))))))
1901
1902(defconst comment-multi-line nil
1903 "*Non-nil means \\[indent-new-comment-line] should continue same comment
c88ab9ce
ER
1904on new line, with no new terminator or starter.
1905This is obsolete because you might as well use \\[newline-and-indent].")
2076c87c
JB
1906
1907(defun indent-new-comment-line ()
1908 "Break line at point and indent, continuing comment if presently within one.
c88ab9ce
ER
1909The body of the continued comment is indented under the previous comment line.
1910
1911This command is intended for styles where you write a comment per line,
1912starting a new comment (and terminating it if necessary) on each line.
1913If you want to continue one comment across several lines, use \\[newline-and-indent]."
2076c87c
JB
1914 (interactive "*")
1915 (let (comcol comstart)
1916 (skip-chars-backward " \t")
1917 (delete-region (point)
1918 (progn (skip-chars-forward " \t")
1919 (point)))
1920 (insert ?\n)
c88ab9ce
ER
1921 (if (not comment-multi-line)
1922 (save-excursion
1923 (if (and comment-start-skip
1924 (let ((opoint (point)))
1925 (forward-line -1)
1926 (re-search-forward comment-start-skip opoint t)))
1927 ;; The old line is a comment.
1928 ;; Set WIN to the pos of the comment-start.
1929 ;; But if the comment is empty, look at preceding lines
1930 ;; to find one that has a nonempty comment.
1931 (let ((win (match-beginning 0)))
1932 (while (and (eolp) (not (bobp))
1933 (let (opoint)
1934 (beginning-of-line)
1935 (setq opoint (point))
1936 (forward-line -1)
1937 (re-search-forward comment-start-skip opoint t)))
1938 (setq win (match-beginning 0)))
1939 ;; Indent this line like what we found.
1940 (goto-char win)
1941 (setq comcol (current-column))
1942 (setq comstart (buffer-substring (point) (match-end 0)))))))
2076c87c
JB
1943 (if comcol
1944 (let ((comment-column comcol)
1945 (comment-start comstart)
1946 (comment-end comment-end))
1947 (and comment-end (not (equal comment-end ""))
c88ab9ce 1948; (if (not comment-multi-line)
2076c87c
JB
1949 (progn
1950 (forward-char -1)
1951 (insert comment-end)
1952 (forward-char 1))
c88ab9ce
ER
1953; (setq comment-column (+ comment-column (length comment-start))
1954; comment-start "")
1955; )
1956 )
2076c87c
JB
1957 (if (not (eolp))
1958 (setq comment-end ""))
1959 (insert ?\n)
1960 (forward-char -1)
1961 (indent-for-comment)
1962 (save-excursion
1963 ;; Make sure we delete the newline inserted above.
1964 (end-of-line)
1965 (delete-char 1)))
1966 (if fill-prefix
1967 (insert fill-prefix)
1968 (indent-according-to-mode)))))
1969
1970(defun auto-fill-mode (&optional arg)
1971 "Toggle auto-fill mode.
1972With arg, turn auto-fill mode on if and only if arg is positive.
1973In auto-fill mode, inserting a space at a column beyond fill-column
1974automatically breaks the line at a previous space."
1975 (interactive "P")
1976 (prog1 (setq auto-fill-function
1977 (if (if (null arg)
1978 (not auto-fill-function)
1979 (> (prefix-numeric-value arg) 0))
1980 'do-auto-fill
1981 nil))
1982 ;; update mode-line
1983 (set-buffer-modified-p (buffer-modified-p))))
1984
1985(defun turn-on-auto-fill ()
1986 "Unconditionally turn on Auto Fill mode."
1987 (auto-fill-mode 1))
1988
1989(defun set-fill-column (arg)
ff1fbe3e
RS
1990 "Set `fill-column' to current column, or to argument if given.
1991The variable `fill-column' has a separate value for each buffer."
2076c87c
JB
1992 (interactive "P")
1993 (setq fill-column (if (integerp arg) arg (current-column)))
1994 (message "fill-column set to %d" fill-column))
1995\f
1996(defun set-selective-display (arg)
ff1fbe3e
RS
1997 "Set `selective-display' to ARG; clear it if no arg.
1998When the value of `selective-display' is a number > 0,
1999lines whose indentation is >= that value are not displayed.
2000The variable `selective-display' has a separate value for each buffer."
2076c87c
JB
2001 (interactive "P")
2002 (if (eq selective-display t)
2003 (error "selective-display already in use for marked lines"))
c88ab9ce
ER
2004 (let ((current-vpos
2005 (save-restriction
2006 (narrow-to-region (point-min) (point))
2007 (goto-char (window-start))
2008 (vertical-motion (window-height)))))
2009 (setq selective-display
2010 (and arg (prefix-numeric-value arg)))
2011 (recenter current-vpos))
2076c87c
JB
2012 (set-window-start (selected-window) (window-start (selected-window)))
2013 (princ "selective-display set to " t)
2014 (prin1 selective-display t)
2015 (princ "." t))
2016
b6a22db0
JB
2017(defconst overwrite-mode-textual " Ovwrt"
2018 "The string displayed in the mode line when in overwrite mode.")
2019(defconst overwrite-mode-binary " Bin Ovwrt"
2020 "The string displayed in the mode line when in binary overwrite mode.")
2021
2076c87c
JB
2022(defun overwrite-mode (arg)
2023 "Toggle overwrite mode.
2024With arg, turn overwrite mode on iff arg is positive.
2025In overwrite mode, printing characters typed in replace existing text
b6a22db0
JB
2026on a one-for-one basis, rather than pushing it to the right. At the
2027end of a line, such characters extend the line. Before a tab,
2028such characters insert until the tab is filled in.
2029\\[quoted-insert] still inserts characters in overwrite mode; this
2030is supposed to make it easier to insert characters when necessary."
2031 (interactive "P")
2032 (setq overwrite-mode
2033 (if (if (null arg) (not overwrite-mode)
2034 (> (prefix-numeric-value arg) 0))
2035 'overwrite-mode-textual))
2036 (force-mode-line-update))
2037
2038(defun binary-overwrite-mode (arg)
2039 "Toggle binary overwrite mode.
2040With arg, turn binary overwrite mode on iff arg is positive.
2041In binary overwrite mode, printing characters typed in replace
2042existing text. Newlines are not treated specially, so typing at the
2043end of a line joins the line to the next, with the typed character
2044between them. Typing before a tab character simply replaces the tab
2045with the character typed.
2046\\[quoted-insert] replaces the text at the cursor, just as ordinary
2047typing characters do.
2048
2049Note that binary overwrite mode is not its own minor mode; it is a
2050specialization of overwrite-mode, entered by setting the
2051`overwrite-mode' variable to `overwrite-mode-binary'."
2076c87c
JB
2052 (interactive "P")
2053 (setq overwrite-mode
b6a22db0 2054 (if (if (null arg)
a61099dd 2055 (not (eq overwrite-mode 'overwrite-mode-binary))
b6a22db0
JB
2056 (> (prefix-numeric-value arg) 0))
2057 'overwrite-mode-binary))
2058 (force-mode-line-update))
2076c87c 2059\f
a61099dd
RS
2060(defvar line-number-mode nil
2061 "*Non-nil means display line number in mode line.")
2062
2063(defun line-number-mode (arg)
2064 "Toggle Line Number mode.
2065With arg, turn Line Number mode on iff arg is positive.
2066When Line Number mode is enabled, the line number appears
2067in the mode line."
2068 (interactive "P")
2069 (setq line-number-mode
2070 (if (null arg) (not line-number-mode)
2071 (> (prefix-numeric-value arg) 0)))
2072 (force-mode-line-update))
2073
2076c87c
JB
2074(defvar blink-matching-paren t
2075 "*Non-nil means show matching open-paren when close-paren is inserted.")
2076
37315725
RS
2077(defconst blink-matching-paren-distance 12000
2078 "*If non-nil, is maximum distance to search for matching open-paren.")
2076c87c
JB
2079
2080(defun blink-matching-open ()
2081 "Move cursor momentarily to the beginning of the sexp before point."
2082 (interactive)
2083 (and (> (point) (1+ (point-min)))
2084 (/= (char-syntax (char-after (- (point) 2))) ?\\ )
2085 blink-matching-paren
2086 (let* ((oldpos (point))
2087 (blinkpos)
2088 (mismatch))
2089 (save-excursion
2090 (save-restriction
2091 (if blink-matching-paren-distance
2092 (narrow-to-region (max (point-min)
2093 (- (point) blink-matching-paren-distance))
2094 oldpos))
2095 (condition-case ()
2096 (setq blinkpos (scan-sexps oldpos -1))
2097 (error nil)))
2098 (and blinkpos (/= (char-syntax (char-after blinkpos))
2099 ?\$)
2100 (setq mismatch
2101 (/= (char-after (1- oldpos))
2102 (logand (lsh (aref (syntax-table)
2103 (char-after blinkpos))
2104 -8)
2105 255))))
2106 (if mismatch (setq blinkpos nil))
2107 (if blinkpos
2108 (progn
2109 (goto-char blinkpos)
2110 (if (pos-visible-in-window-p)
2111 (sit-for 1)
2112 (goto-char blinkpos)
2113 (message
2114 "Matches %s"
2115 (if (save-excursion
2116 (skip-chars-backward " \t")
2117 (not (bolp)))
2118 (buffer-substring (progn (beginning-of-line) (point))
2119 (1+ blinkpos))
2120 (buffer-substring blinkpos
2121 (progn
2122 (forward-char 1)
2123 (skip-chars-forward "\n \t")
2124 (end-of-line)
2125 (point)))))))
2126 (cond (mismatch
2127 (message "Mismatched parentheses"))
2128 ((not blink-matching-paren-distance)
2129 (message "Unmatched parenthesis"))))))))
2130
2131;Turned off because it makes dbx bomb out.
2132(setq blink-paren-function 'blink-matching-open)
2133
9a1277dd
RS
2134;; This executes C-g typed while Emacs is waiting for a command.
2135;; Quitting out of a program does not go through here;
2136;; that happens in the QUIT macro at the C code level.
2076c87c 2137(defun keyboard-quit ()
af39530e
RS
2138 "Signal a quit condition.
2139During execution of Lisp code, this character causes a quit directly.
2140At top-level, as an editor command, this simply beeps."
2076c87c 2141 (interactive)
66050f10
RS
2142 (and transient-mark-mode mark-active
2143 (progn
2144 (setq mark-active nil)
2145 (run-hooks 'deactivate-mark-hook)))
2076c87c
JB
2146 (signal 'quit nil))
2147
2148(define-key global-map "\C-g" 'keyboard-quit)
2149\f
2150(defun set-variable (var val)
2151 "Set VARIABLE to VALUE. VALUE is a Lisp object.
2152When using this interactively, supply a Lisp expression for VALUE.
3a801d0c
ER
2153If you want VALUE to be a string, you must surround it with doublequotes.
2154
2155If VARIABLE has a `variable-interactive' property, that is used as if
2156it were the arg to `interactive' (which see) to interactively read the value."
2076c87c
JB
2157 (interactive
2158 (let* ((var (read-variable "Set variable: "))
2159 (minibuffer-help-form
2160 '(funcall myhelp))
2161 (myhelp
2162 (function
2163 (lambda ()
2164 (with-output-to-temp-buffer "*Help*"
2165 (prin1 var)
2166 (princ "\nDocumentation:\n")
2167 (princ (substring (documentation-property var 'variable-documentation)
2168 1))
2169 (if (boundp var)
2170 (let ((print-length 20))
2171 (princ "\n\nCurrent value: ")
2172 (prin1 (symbol-value var))))
2173 nil)))))
2174 (list var
3a801d0c
ER
2175 (let ((prop (get var 'variable-interactive)))
2176 (if prop
2177 ;; Use VAR's `variable-interactive' property
2178 ;; as an interactive spec for prompting.
2179 (call-interactively (list 'lambda '(arg)
2180 (list 'interactive prop)
2181 'arg))
2182 (eval-minibuffer (format "Set %s to value: " var)))))))
2076c87c 2183 (set var val))
c88ab9ce
ER
2184
2185;;; simple.el ends here