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