![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to simple.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to simple.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 1: ;; Basic editing commands for Emacs
2: ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is free software; you can redistribute it and/or modify
7: ;; it under the terms of the GNU General Public License as published by
8: ;; the Free Software Foundation; either version 1, or (at your option)
9: ;; any later version.
10:
11: ;; GNU Emacs is distributed in the hope that it will be useful,
12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: ;; GNU General Public License for more details.
15:
16: ;; You should have received a copy of the GNU General Public License
17: ;; along with GNU Emacs; see the file COPYING. If not, write to
18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19:
20:
21: (defun open-line (arg)
22: "Insert a newline and leave point before it.
23: With arg, inserts that many newlines."
24: (interactive "*p")
25: (let ((flag (and (bolp) (not (bobp)))))
26: (if flag (forward-char -1))
27: (while (> arg 0)
28: (insert ?\n)
29: (goto-char (1- (point)))
30: (setq arg (1- arg)))
31: (if flag (forward-char 1))))
32:
33: (defun split-line ()
34: "Split current line, moving portion beyond point vertically down."
35: (interactive "*")
36: (skip-chars-forward " \t")
37: (let ((col (current-column))
38: (pos (point)))
39: (insert ?\n)
40: (indent-to col 0)
41: (goto-char pos)))
42:
43: (defun quoted-insert (arg)
44: "Read next input character and insert it.
45: Useful for inserting control characters.
46: You may also type up to 3 octal digits, to insert a character with that code"
47: (interactive "*p")
48: (let ((char (read-quoted-char)))
49: (while (> arg 0)
50: (insert char)
51: (setq arg (1- arg)))))
52:
53: (defun delete-indentation (&optional arg)
54: "Join this line to previous and fix up whitespace at join.
55: With argument, join this line to following line."
56: (interactive "*P")
57: (beginning-of-line)
58: (if arg (forward-line 1))
59: (if (eq (preceding-char) ?\n)
60: (progn
61: (delete-region (point) (1- (point)))
62: (fixup-whitespace))))
63:
64: (defun fixup-whitespace ()
65: "Fixup white space between objects around point.
66: Leave one space or none, according to the context."
67: (interactive "*")
68: (save-excursion
69: (delete-horizontal-space)
70: (if (or (looking-at "^\\|\\s)\\|$")
71: (save-excursion (forward-char -1)
72: (looking-at "\\s(\\|\\s'")))
73: nil
74: (insert ?\ ))))
75:
76: (defun delete-horizontal-space ()
77: "Delete all spaces and tabs around point."
78: (interactive "*")
79: (skip-chars-backward " \t")
80: (delete-region (point) (progn (skip-chars-forward " \t") (point))))
81:
82: (defun just-one-space ()
83: "Delete all spaces and tabs around point, leaving one space."
84: (interactive "*")
85: (skip-chars-backward " \t")
86: (if (= (following-char) ? )
87: (forward-char 1)
88: (insert ? ))
89: (delete-region (point) (progn (skip-chars-forward " \t") (point))))
90:
91: (defun delete-blank-lines ()
92: "On blank line, delete all surrounding blank lines, leaving just one.
93: On isolated blank line, delete that one.
94: On nonblank line, delete all blank lines that follow it."
95: (interactive "*")
96: (let (thisblank singleblank)
97: (save-excursion
98: (beginning-of-line)
99: (setq thisblank (looking-at "[ \t]*$"))
100: (setq singleblank
101: (and thisblank
102: (not (looking-at "[ \t]*\n[ \t]*$"))
103: (or (bobp)
104: (progn (forward-line -1)
105: (not (looking-at "[ \t]*$")))))))
106: (if thisblank
107: (progn
108: (beginning-of-line)
109: (if singleblank (forward-line 1))
110: (delete-region (point)
111: (if (re-search-backward "[^ \t\n]" nil t)
112: (progn (forward-line 1) (point))
113: (point-min)))))
114: (if (not (and thisblank singleblank))
115: (save-excursion
116: (end-of-line)
117: (forward-line 1)
118: (delete-region (point)
119: (if (re-search-forward "[^ \t\n]" nil t)
120: (progn (beginning-of-line) (point))
121: (point-max)))))))
122:
123: (defun back-to-indentation ()
124: "Move point to the first non-whitespace character on this line."
125: (interactive)
126: (beginning-of-line 1)
127: (skip-chars-forward " \t"))
128:
129: (defun newline-and-indent ()
130: "Insert a newline, then indent according to major mode.
131: Indentation is done using the current indent-line-function.
132: In programming language modes, this is the same as TAB.
133: In some text modes, where TAB inserts a tab, this indents to the
134: specified left-margin column."
135: (interactive "*")
136: (delete-region (point) (progn (skip-chars-backward " \t") (point)))
137: (newline)
138: (indent-according-to-mode))
139:
140: (defun reindent-then-newline-and-indent ()
141: "Reindent current line, insert newline, then indent the new line.
142: Indentation of both lines is done according to the current major mode,
143: which means that the current value of indent-line-function is called.
144: In programming language modes, this is the same as TAB.
145: In some text modes, where TAB inserts a tab, this indents to the
146: specified left-margin column."
147: (interactive "*")
148: (save-excursion
149: (delete-region (point) (progn (skip-chars-backward " \t") (point)))
150: (indent-according-to-mode))
151: (newline)
152: (indent-according-to-mode))
153:
154: (defun kill-forward-chars (arg)
155: (if (listp arg) (setq arg (car arg)))
156: (if (eq arg '-) (setq arg -1))
157: (kill-region (point) (+ (point) arg)))
158:
159: (defun kill-backward-chars (arg)
160: (if (listp arg) (setq arg (car arg)))
161: (if (eq arg '-) (setq arg -1))
162: (kill-region (point) (- (point) arg)))
163:
164: (defun backward-delete-char-untabify (arg &optional killp)
165: "Delete characters backward, changing tabs into spaces.
166: Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
167: Interactively, ARG is the prefix arg (default 1)
168: and KILLP is t if prefix arg is was specified."
169: (interactive "*p\nP")
170: (let ((count arg))
171: (save-excursion
172: (while (and (> count 0) (not (bobp)))
173: (if (= (preceding-char) ?\t)
174: (let ((col (current-column)))
175: (forward-char -1)
176: (setq col (- col (current-column)))
177: (insert-char ?\ col)
178: (delete-char 1)))
179: (forward-char -1)
180: (setq count (1- count)))))
181: (delete-backward-char arg killp))
182:
183: (defun zap-to-char (arg char)
184: "Kill up to (but not including) ARG'th occurrence of CHAR.
185: Goes backward if ARG is negative; goes to end of buffer if CHAR not found."
186: (interactive "*p\ncZap to char: ")
187: (kill-region (point) (if (search-forward (char-to-string char) nil t arg)
188: (progn (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
189: (point))
190: (if (> arg 0) (point-max) (point-min)))))
191:
192: (defun beginning-of-buffer (&optional arg)
193: "Move point to the beginning of the buffer; leave mark at previous position.
194: With arg N, put point N/10 of the way from the true beginning.
195: Don't use this in Lisp programs!
196: \(goto-char (point-min)) is faster and does not set the mark."
197: (interactive "P")
198: (push-mark)
199: (goto-char (if arg
200: (if (> (buffer-size) 10000)
201: ;; Avoid overflow for large buffer sizes!
202: (* (prefix-numeric-value arg)
203: (/ (buffer-size) 10))
204: (/ (+ 10 (* (buffer-size) (prefix-numeric-value arg))) 10))
205: (point-min)))
206: (if arg (forward-line 1)))
207:
208: (defun end-of-buffer (&optional arg)
209: "Move point to the end of the buffer; leave mark at previous position.
210: With arg N, put point N/10 of the way from the true end.
211: Don't use this in Lisp programs!
212: \(goto-char (point-max)) is faster and does not set the mark."
213: (interactive "P")
214: (push-mark)
215: (goto-char (if arg
216: (- (1+ (buffer-size))
217: (if (> (buffer-size) 10000)
218: ;; Avoid overflow for large buffer sizes!
219: (* (prefix-numeric-value arg)
220: (/ (buffer-size) 10))
221: (/ (* (buffer-size) (prefix-numeric-value arg)) 10)))
222: (point-max)))
223: (if arg (forward-line 1)))
224:
225: (defun mark-whole-buffer ()
226: "Put point at beginning and mark at end of buffer."
227: (interactive)
228: (push-mark (point))
229: (push-mark (point-max))
230: (goto-char (point-min)))
231:
232: (defun count-lines-region (start end)
233: "Print number of lines in the region."
234: (interactive "r")
235: (message "Region has %d lines" (count-lines start end)))
236:
237: (defun what-line ()
238: "Print the current line number (in the buffer) of point."
239: (interactive)
240: (save-restriction
241: (widen)
242: (save-excursion
243: (beginning-of-line)
244: (message "Line %d"
245: (1+ (count-lines 1 (point)))))))
246:
247: (defun count-lines (start end)
248: "Return number of newlines between START and END."
249: (save-excursion
250: (save-restriction
251: (narrow-to-region start end)
252: (goto-char (point-min))
253: (- (buffer-size) (forward-line (buffer-size))))))
254:
255: (defun what-cursor-position ()
256: "Print info on cursor position (on screen and within buffer)."
257: (interactive)
258: (let* ((char (following-char))
259: (beg (point-min))
260: (end (point-max))
261: (pos (point))
262: (total (buffer-size))
263: (percent (if (> total 50000)
264: ;; Avoid overflow from multiplying by 100!
265: (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
266: (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
267: (hscroll (if (= (window-hscroll) 0)
268: ""
269: (format " Hscroll=%d" (window-hscroll))))
270: (col (current-column)))
271: (if (= pos end)
272: (if (or (/= beg 1) (/= end (1+ total)))
273: (message "point=%d of %d(%d%%) <%d - %d> column %d %s"
274: pos total percent beg end col hscroll)
275: (message "point=%d of %d(%d%%) column %d %s"
276: pos total percent col hscroll))
277: (if (or (/= beg 1) (/= end (1+ total)))
278: (message "Char: %s (0%o) point=%d of %d(%d%%) <%d - %d> column %d %s"
279: (single-key-description char) char pos total percent beg end col hscroll)
280: (message "Char: %s (0%o) point=%d of %d(%d%%) column %d %s"
281: (single-key-description char) char pos total percent col hscroll)))))
282:
283: (defun fundamental-mode ()
284: "Major mode not specialized for anything in particular.
285: Other major modes are defined by comparison with this one."
286: (interactive)
287: (kill-all-local-variables))
288:
289: (put 'eval-expression 'disabled t)
290:
291: ;; We define this, rather than making eval interactive,
292: ;; for the sake of completion of names like eval-region, eval-current-buffer.
293: (defun eval-expression (expression)
294: "Evaluate EXPRESSION and print value in minibuffer.
295: Value is also consed on to front of variable values 's value."
296: (interactive "xEval: ")
297: (setq values (cons (eval expression) values))
298: (prin1 (car values) t))
299:
300: (defun edit-and-eval-command (prompt command)
301: "Prompting with PROMPT, let user edit COMMAND and eval result.
302: COMMAND is a Lisp expression. Let user edit that expression in
303: the minibuffer, then read and evaluate the result."
304: (eval (read-minibuffer prompt
305: (prin1-to-string command))))
306:
307: (defvar repeat-complex-command-map (copy-alist minibuffer-local-map))
308: (define-key repeat-complex-command-map "\ep" 'previous-complex-command)
309: (define-key repeat-complex-command-map "\en" 'next-complex-command)
310: (defun repeat-complex-command (repeat-complex-command-arg)
311: "Edit and re-evaluate last complex command, or ARGth from last.
312: A complex command is one which used the minibuffer.
313: The command is placed in the minibuffer as a Lisp form for editing.
314: The result is executed, repeating the command as changed.
315: If the command has been changed or is not the most recent previous command
316: it is added to the front of the command history.
317: Whilst editing the command, the following commands are available:
318: \\{repeat-complex-command-map}"
319: (interactive "p")
320: (let ((elt (nth (1- repeat-complex-command-arg) command-history))
321: newcmd)
322: (if elt
323: (progn
324: (setq newcmd (read-from-minibuffer "Redo: "
325: (prin1-to-string elt)
326: repeat-complex-command-map
327: t))
328: ;; If command to be redone does not match front of history,
329: ;; add it to the history.
330: (or (equal newcmd (car command-history))
331: (setq command-history (cons newcmd command-history)))
332: (eval newcmd))
333: (ding))))
334:
335: (defun next-complex-command (n)
336: "Inserts the next element of `command-history' into the minibuffer."
337: (interactive "p")
338: (let ((narg (min (max 1 (- repeat-complex-command-arg n))
339: (length command-history))))
340: (if (= repeat-complex-command-arg narg)
341: (error (if (= repeat-complex-command-arg 1)
342: "No following item in command history"
343: "No preceeding item command history"))
344: (erase-buffer)
345: (setq repeat-complex-command-arg narg)
346: (insert (prin1-to-string (nth (1- repeat-complex-command-arg)
347: command-history)))
348: (goto-char (point-min)))))
349:
350: (defun previous-complex-command (n)
351: "Inserts the previous element of `command-history' into the minibuffer."
352: (interactive "p")
353: (next-complex-command (- n)))
354:
355: (defun goto-line (arg)
356: "Goto line ARG, counting from line 1 at beginning of buffer."
357: (interactive "NGoto line: ")
358: (save-restriction
359: (widen)
360: (goto-char 1)
361: (if (eq selective-display t)
362: (re-search-forward "[\n\C-m]" nil 'end (1- arg))
363: (forward-line (1- arg)))))
364:
365: ;Put this on C-x u, so we can force that rather than C-_ into startup msg
366: (fset 'advertised-undo 'undo)
367:
368: (defun undo (&optional arg)
369: "Undo some previous changes.
370: Repeat this command to undo more changes.
371: A numeric argument serves as a repeat count."
372: (interactive "*p")
373: (let ((modified (buffer-modified-p)))
374: (or (eq (selected-window) (minibuffer-window))
375: (message "Undo!"))
376: (or (eq last-command 'undo)
377: (progn (undo-start)
378: (undo-more 1)))
379: (setq this-command 'undo)
380: (undo-more (or arg 1))
381: (and modified (not (buffer-modified-p))
382: (delete-auto-save-file-if-necessary))))
383:
384: (defun shell-command (command &optional flag)
385: "Execute string COMMAND in inferior shell; display output, if any.
386: Optional second arg non-nil (prefix arg, if interactive)
387: means insert output in current buffer after point (leave mark after it)."
388: (interactive "sShell command: \nP")
389: (if flag
390: (progn (barf-if-buffer-read-only)
391: (push-mark)
392: (call-process shell-file-name nil t nil
393: "-c" command)
394: (exchange-point-and-mark))
395: (shell-command-on-region (point) (point) command nil)))
396:
397: (defun shell-command-on-region (start end command &optional flag interactive)
398: "Execute string COMMAND in inferior shell with region as input.
399: Normally display output (if any) in temp buffer;
400: Prefix arg means replace the region with it.
401: Noninteractive args are START, END, COMMAND, FLAG.
402: Noninteractively FLAG means insert output in place of text from START to END,
403: and put point at the end, but don't alter the mark."
404: (interactive "r\nsShell command on region: \nP\np")
405: (if flag
406: ;; Replace specified region with output from command.
407: (let ((swap (and interactive (< (point) (mark)))))
408: ;; Don't muck with mark
409: ;; unless called interactively.
410: (and interactive (push-mark))
411: (call-process-region start end shell-file-name t t nil
412: "-c" command)
413: (and interactive swap (exchange-point-and-mark)))
414: (let ((buffer (get-buffer-create "*Shell Command Output*")))
415: (if (eq buffer (current-buffer))
416: ;; If the input is the same buffer as the output,
417: ;; delete everything but the specified region,
418: ;; then replace that region with the output.
419: (progn (delete-region end (point-max))
420: (delete-region (point-min) start)
421: (call-process-region (point-min) (point-max)
422: shell-file-name t t nil
423: "-c" command))
424: ;; Clear the output buffer, then run the command with output there.
425: (save-excursion
426: (set-buffer buffer)
427: (erase-buffer))
428: (call-process-region start end shell-file-name
429: nil buffer nil
430: "-c" command))
431: (if (save-excursion
432: (set-buffer buffer)
433: (> (buffer-size) 0))
434: (set-window-start (display-buffer buffer) 1)
435: (message "(Shell command completed with no output)")))))
436:
437: (defun universal-argument ()
438: "Begin a numeric argument for the following command.
439: Digits or minus sign following \\[universal-argument] make up the numeric argument.
440: \\[universal-argument] following the digits or minus sign ends the argument.
441: \\[universal-argument] without digits or minus sign provides 4 as argument.
442: Repeating \\[universal-argument] without digits or minus sign
443: multiplies the argument by 4 each time."
444: (interactive nil)
445: (let ((c-u 4) (argstartchar last-command-char)
446: char)
447: ; (describe-arg (list c-u) 1)
448: (setq char (read-char))
449: (while (= char argstartchar)
450: (setq c-u (* 4 c-u))
451: ; (describe-arg (list c-u) 1)
452: (setq char (read-char)))
453: (prefix-arg-internal char c-u nil)))
454:
455: (defun prefix-arg-internal (char c-u value)
456: (let ((sign 1))
457: (if (and (numberp value) (< value 0))
458: (setq sign -1 value (- value)))
459: (if (eq value '-)
460: (setq sign -1 value nil))
461: ; (describe-arg value sign)
462: (while (= ?- char)
463: (setq sign (- sign) c-u nil)
464: ; (describe-arg value sign)
465: (setq char (read-char)))
466: (while (and (>= char ?0) (<= char ?9))
467: (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0)) c-u nil)
468: ; (describe-arg value sign)
469: (setq char (read-char)))
470: ;; Repeating the arg-start char after digits
471: ;; terminates the argument but is ignored.
472: (if (eq (lookup-key global-map (make-string 1 char)) 'universal-argument)
473: (setq char (read-char)))
474: (setq prefix-arg
475: (cond (c-u (list c-u))
476: ((numberp value) (* value sign))
477: ((= sign -1) '-)))
478: (setq unread-command-char char)))
479:
480: ;(defun describe-arg (value sign)
481: ; (cond ((numberp value)
482: ; (message "Arg: %d" (* value sign)))
483: ; ((consp value)
484: ; (message "Arg: C-u factor %d" (car value)))
485: ; ((< sign 0)
486: ; (message "Arg: -"))))
487:
488: (defun digit-argument (arg)
489: "Part of the numeric argument for the next command.
490: \\[universal-argument] following digits or minus sign ends the argument."
491: (interactive "P")
492: (prefix-arg-internal last-command-char nil arg))
493:
494: (defun negative-argument (arg)
495: "Begin a negative numeric argument for the next command.
496: \\[universal-argument] following digits or minus sign ends the argument."
497: (interactive "P")
498: (prefix-arg-internal ?- nil arg))
499:
500: (defun forward-to-indentation (arg)
501: "Move forward ARG lines and position at first nonblank character."
502: (interactive "p")
503: (forward-line arg)
504: (skip-chars-forward " \t"))
505:
506: (defun backward-to-indentation (arg)
507: "Move backward ARG lines and position at first nonblank character."
508: (interactive "p")
509: (forward-line (- arg))
510: (skip-chars-forward " \t"))
511:
512: (defun kill-line (&optional arg)
513: "Kill the rest of the current line; if no nonblanks there, kill thru newline.
514: With prefix argument, kill that many lines from point.
515: Negative arguments kill lines backward.
516:
517: When calling from a program, nil means \"no arg\",
518: a number counts as a prefix arg."
519: (interactive "*P")
520: (kill-region (point)
521: (progn
522: (if arg
523: (forward-line (prefix-numeric-value arg))
524: (if (eobp)
525: (signal 'end-of-buffer nil))
526: (if (looking-at "[ \t]*$")
527: (forward-line 1)
528: (end-of-line)))
529: (point))))
530:
531: ;;;; The kill ring
532:
533: (defvar kill-ring nil
534: "List of killed text sequences.")
535:
536: (defconst kill-ring-max 30
537: "*Maximum length of kill ring before oldest elements are thrown away.")
538:
539: (defvar kill-ring-yank-pointer nil
540: "The tail of the kill ring whose car is the last thing yanked.")
541:
542: (defun kill-append (string before-p)
543: (setcar kill-ring
544: (if before-p
545: (concat string (car kill-ring))
546: (concat (car kill-ring) string))))
547:
548: (defun kill-region (beg end)
549: "Kill between point and mark.
550: The text is deleted but saved in the kill ring.
551: The command \\[yank] can retrieve it from there.
552: \(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
553:
554: This is the primitive for programs to kill text (as opposed to deleting it).
555: Supply two arguments, character numbers indicating the stretch of text
556: to be killed.
557: Any command that calls this function is a \"kill command\".
558: If the previous command was also a kill command,
559: the text killed this time appends to the text killed last time
560: to make one entry in the kill ring."
561: (interactive "*r")
562: (if (and (not (eq buffer-undo-list t))
563: (not (eq last-command 'kill-region))
564: (not (eq beg end))
565: ;; This test is here in case someone wants to remove the `*'
566: ;; above, so that the text gets stored in the kill ring
567: ;; even though it doesn't get deleted.
568: (not buffer-read-only))
569: ;; Don't let the undo list be truncated before we can even access it.
570: (let ((undo-high-threshold (+ (- (max beg end) (min beg end)) 100)))
571: (delete-region beg end)
572: ;; Take the same string recorded for undo
573: ;; and put it in the kill-ring.
574: (setq kill-ring (cons (car (car buffer-undo-list)) kill-ring))
575: (if (> (length kill-ring) kill-ring-max)
576: (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
577: (setq this-command 'kill-region)
578: (setq kill-ring-yank-pointer kill-ring))
579: (copy-region-as-kill beg end)
580: (delete-region beg end)))
581:
582: (fset 'kill-ring-save 'copy-region-as-kill)
583:
584: (defun copy-region-as-kill (beg end)
585: "Save the region as if killed, but don't kill it."
586: (interactive "r")
587: (if (eq last-command 'kill-region)
588: (kill-append (buffer-substring beg end) (< end beg))
589: (setq kill-ring (cons (buffer-substring beg end) kill-ring))
590: (if (> (length kill-ring) kill-ring-max)
591: (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
592: (setq this-command 'kill-region)
593: (setq kill-ring-yank-pointer kill-ring))
594:
595: (defun append-next-kill ()
596: "Cause following command, if kill, to append to previous kill."
597: (interactive)
598: (if (interactive-p)
599: (setq this-command 'kill-region)
600: (setq last-command 'kill-region)))
601:
602: (defun rotate-yank-pointer (arg)
603: "Rotate the yanking point in the kill ring."
604: (interactive "p")
605: (let ((length (length kill-ring)))
606: (if (zerop length)
607: (error "Kill ring is empty")
608: (setq kill-ring-yank-pointer
609: (nthcdr (% (+ arg (- length (length kill-ring-yank-pointer)))
610: length)
611: kill-ring)))))
612:
613: (defun yank-pop (arg)
614: "Replace just-yanked stretch of killed-text with a different stretch.
615: This command is allowed only immediately after a yank or a yank-pop.
616: At such a time, the region contains a stretch of reinserted
617: previously-killed text. yank-pop deletes that text and inserts in its
618: place a different stretch of killed text.
619:
620: With no argument, the previous kill is inserted.
621: With argument n, the n'th previous kill is inserted.
622: If n is negative, this is a more recent kill.
623:
624: The sequence of kills wraps around, so that after the oldest one
625: comes the newest one."
626: (interactive "*p")
627: (if (not (eq last-command 'yank))
628: (error "Previous command was not a yank"))
629: (setq this-command 'yank)
630: (let ((before (< (point) (mark))))
631: (delete-region (point) (mark))
632: (rotate-yank-pointer arg)
633: (set-mark (point))
634: (insert (car kill-ring-yank-pointer))
635: (if before (exchange-point-and-mark))))
636:
637: (defun yank (&optional arg)
638: "Reinsert the last stretch of killed text.
639: More precisely, reinsert the stretch of killed text most recently
640: killed OR yanked.
641: With just C-U as argument, same but put point in front (and mark at end).
642: With argument n, reinsert the nth most recently killed stretch of killed
643: text.
644: See also the command \\[yank-pop]."
645: (interactive "*P")
646: (rotate-yank-pointer (if (listp arg) 0
647: (if (eq arg '-) -1
648: (1- arg))))
649: (push-mark (point))
650: (insert (car kill-ring-yank-pointer))
651: (if (consp arg)
652: (exchange-point-and-mark)))
653:
654: (defun insert-buffer (buffer)
655: "Insert after point the contents of BUFFER.
656: Puts mark after the inserted text.
657: BUFFER may be a buffer or a buffer name."
658: (interactive "*bInsert buffer: ")
659: (or (bufferp buffer)
660: (setq buffer (get-buffer buffer)))
661: (let (start end newmark)
662: (save-excursion
663: (save-excursion
664: (set-buffer buffer)
665: (setq start (point-min) end (point-max)))
666: (insert-buffer-substring buffer start end)
667: (setq newmark (point)))
668: (push-mark newmark)))
669:
670: (defun append-to-buffer (buffer start end)
671: "Append to specified buffer the text of the region.
672: It is inserted into that buffer before its point.
673:
674: When calling from a program, give three arguments:
675: a buffer or the name of one, and two character numbers
676: specifying the portion of the current buffer to be copied."
677: (interactive "BAppend to buffer: \nr")
678: (let ((oldbuf (current-buffer)))
679: (save-excursion
680: (set-buffer (get-buffer-create buffer))
681: (insert-buffer-substring oldbuf start end))))
682:
683: (defun prepend-to-buffer (buffer start end)
684: "Prepend to specified buffer the text of the region.
685: It is inserted into that buffer after its point.
686:
687: When calling from a program, give three arguments:
688: a buffer or the name of one, and two character numbers
689: specifying the portion of the current buffer to be copied."
690: (interactive "BPrepend to buffer: \nr")
691: (let ((oldbuf (current-buffer)))
692: (save-excursion
693: (set-buffer (get-buffer-create buffer))
694: (save-excursion
695: (insert-buffer-substring oldbuf start end)))))
696:
697: (defun copy-to-buffer (buffer start end)
698: "Copy to specified buffer the text of the region.
699: It is inserted into that buffer, replacing existing text there.
700:
701: When calling from a program, give three arguments:
702: a buffer or the name of one, and two character numbers
703: specifying the portion of the current buffer to be copied."
704: (interactive "BCopy to buffer: \nr")
705: (let ((oldbuf (current-buffer)))
706: (save-excursion
707: (set-buffer (get-buffer-create buffer))
708: (erase-buffer)
709: (save-excursion
710: (insert-buffer-substring oldbuf start end)))))
711:
712: (defun mark ()
713: "Return this buffer's mark value as integer, or nil if no mark.
714: If you are using this in an editing command, you are most likely making
715: a mistake; see the documentation of `set-mark'."
716: (marker-position (mark-marker)))
717:
718: (defun set-mark (pos)
719: "Set this buffer's mark to POS. Don't use this function!
720: That is to say, don't use this function unless you want
721: the user to see that the mark has moved, and you want the previous
722: mark position to be lost.
723:
724: Normally, when a new mark is set, the old one should go on the stack.
725: This is why most applications should use push-mark, not set-mark.
726:
727: Novice emacs-lisp programmers often try to use the mark for the wrong
728: purposes. The mark saves a location for the user's convenience.
729: Most editing commands should not alter the mark.
730: To remember a location for internal use in the Lisp program,
731: store it in a Lisp variable. Example:
732:
733: (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
734:
735: (set-marker (mark-marker) pos (current-buffer)))
736:
737: (defvar mark-ring nil
738: "The list of saved former marks of the current buffer,
739: most recent first.")
740: (make-variable-buffer-local 'mark-ring)
741:
742: (defconst mark-ring-max 16
743: "*Maximum size of mark ring. Start discarding off end if gets this big.")
744:
745: (defun set-mark-command (arg)
746: "Set mark at where point is, or jump to mark.
747: With no prefix argument, set mark, and push previous mark on mark ring.
748: With argument, jump to mark, and pop into mark off the mark ring.
749:
750: Novice emacs-lisp programmers often try to use the mark for the wrong
751: purposes. See the documentation of `set-mark' for more information."
752: (interactive "P")
753: (if (null arg)
754: (push-mark)
755: (if (null (mark))
756: (error "No mark set in this buffer")
757: (goto-char (mark))
758: (pop-mark))))
759:
760: (defun push-mark (&optional location nomsg)
761: "Set mark at LOCATION (point, by default) and push old mark on mark ring.
762: Displays \"Mark set\" unless the optional second arg NOMSG is non-nil.
763:
764: Novice emacs-lisp programmers often try to use the mark for the wrong
765: purposes. See the documentation of `set-mark' for more information."
766: (if (null (mark))
767: nil
768: (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
769: (if (> (length mark-ring) mark-ring-max)
770: (progn
771: (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
772: (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
773: (set-mark (or location (point)))
774: (or nomsg executing-macro (> (minibuffer-depth) 0)
775: (message "Mark set")))
776:
777: (defun pop-mark ()
778: "Pop off mark ring into the buffer's actual mark.
779: Does not set point. Does nothing if mark ring is empty."
780: (if mark-ring
781: (progn
782: (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
783: (set-mark (+ 0 (car mark-ring)))
784: (move-marker (car mark-ring) nil)
785: (if (null (mark)) (ding))
786: (setq mark-ring (cdr mark-ring)))))
787:
788: (fset 'exchange-dot-and-mark 'exchange-point-and-mark)
789: (defun exchange-point-and-mark ()
790: "Put the mark where point is now, and point where the mark is now."
791: (interactive nil)
792: (let ((omark (mark)))
793: (if (null omark)
794: (error "No mark set in this buffer"))
795: (set-mark (point))
796: (goto-char omark)
797: nil))
798:
799: (defun next-line (arg)
800: "Move cursor vertically down ARG lines.
801: If there is no character in the target line exactly under the current column,
802: the cursor is positioned after the character in that line which spans this
803: column, or at the end of the line if it is not long enough.
804: If there is no line in the buffer after this one,
805: a newline character is inserted to create a line
806: and the cursor moves to that line.
807:
808: The command \\[set-goal-column] can be used to create
809: a semipermanent goal column to which this command always moves.
810: Then it does not try to move vertically.
811:
812: If you are thinking of using this in a Lisp program, consider
813: using `forward-line' instead. It is usually easier to use
814: and more reliable (no dependence on goal column, etc.)."
815: (interactive "p")
816: (if (= arg 1)
817: (let ((opoint (point)))
818: (forward-line 1)
819: (if (or (= opoint (point))
820: (not (eq (preceding-char) ?\n)))
821: (insert ?\n)
822: (goto-char opoint)
823: (next-line-internal arg)))
824: (next-line-internal arg))
825: nil)
826:
827: (defun previous-line (arg)
828: "Move cursor vertically up ARG lines.
829: If there is no character in the target line exactly over the current column,
830: the cursor is positioned after the character in that line which spans this
831: column, or at the end of the line if it is not long enough.
832:
833: The command \\[set-goal-column] can be used to create
834: a semipermanent goal column to which this command always moves.
835: Then it does not try to move vertically.
836:
837: If you are thinking of using this in a Lisp program, consider using
838: `forward-line' with negative argument instead.. It is usually easier
839: to use and more reliable (no dependence on goal column, etc.)."
840: (interactive "p")
841: (next-line-internal (- arg))
842: nil)
843:
844: (defconst track-eol nil
845: "*Non-nil means vertical motion starting at the end of a line should keep to ends of lines.
846: This means moving to the end of each line moved onto.")
847:
848: (defvar goal-column nil
849: "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil.")
850:
851: (defvar temporary-goal-column 0
852: "Current goal column for vertical motion.
853: It is the column where point was at the start of current run of vertical motion commands.")
854:
855: (defun next-line-internal (arg)
856: (if (not (or (eq last-command 'next-line)
857: (eq last-command 'previous-line)))
858: (setq temporary-goal-column
859: (if (and track-eol (eolp))
860: t
861: (current-column))))
862: (if (not (integerp selective-display))
863: (forward-line arg)
864: ;; Move by arg lines, but ignore invisible ones.
865: (while (> arg 0)
866: (vertical-motion 1)
867: (forward-char -1)
868: (forward-line 1)
869: (setq arg (1- arg)))
870: (while (< arg 0)
871: (vertical-motion -1)
872: (beginning-of-line)
873: (setq arg (1+ arg))))
874: (if (eq (or goal-column temporary-goal-column) t)
875: (end-of-line)
876: (move-to-column (or goal-column temporary-goal-column)))
877: nil)
878:
879:
880: (defun set-goal-column (arg)
881: "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
882: Those commands will move to this position in the line moved to
883: rather than trying to keep the same horizontal position.
884: With a non-nil argument, clears out the goal column
885: so that \\[next-line] and \\[previous-line] resume vertical motion."
886: (interactive "P")
887: (if arg
888: (progn
889: (setq goal-column nil)
890: (message "No goal column"))
891: (setq goal-column (current-column))
892: (message (substitute-command-keys
893: "Goal column %d (use \\[set-goal-column] with an arg to unset it)")
894: goal-column))
895: nil)
896:
897: (defun transpose-chars (arg)
898: "Interchange characters around point, moving forward one character.
899: With prefix arg ARG, effect is to take character before point
900: and drag it forward past ARG other characters (backward if ARG negative).
901: If no argument and at end of line, the previous two chars are exchanged."
902: (interactive "*P")
903: (and (null arg) (eolp) (forward-char -1))
904: (transpose-subr 'forward-char (prefix-numeric-value arg)))
905:
906: (defun transpose-words (arg)
907: "Interchange words around point, leaving point at end of them.
908: With prefix arg ARG, effect is to take word before or around point
909: and drag it forward past ARG other words (backward if ARG negative).
910: If ARG is zero, the words around or after point and around or after mark
911: are interchanged."
912: (interactive "*p")
913: (transpose-subr 'forward-word arg))
914:
915: (defun transpose-sexps (arg)
916: "Like \\[transpose-words] but applies to sexps.
917: Does not work on a sexp that point is in the middle of
918: if it is a list or string."
919: (interactive "*p")
920: (transpose-subr 'forward-sexp arg))
921:
922: (defun transpose-lines (arg)
923: "Exchange current line and previous line, leaving point after both.
924: With argument ARG, takes previous line and moves it past ARG lines.
925: With argument 0, interchanges line point is in with line mark is in."
926: (interactive "*p")
927: (transpose-subr (function
928: (lambda (arg)
929: (if (= arg 1)
930: (progn
931: ;; Move forward over a line,
932: ;; but create a newline if none exists yet.
933: (end-of-line)
934: (if (eobp)
935: (newline)
936: (forward-char 1)))
937: (forward-line arg))))
938: arg))
939:
940: (defun transpose-subr (mover arg)
941: (let (start1 end1 start2 end2)
942: (if (= arg 0)
943: (progn
944: (save-excursion
945: (funcall mover 1)
946: (setq end2 (point))
947: (funcall mover -1)
948: (setq start2 (point))
949: (goto-char (mark))
950: (funcall mover 1)
951: (setq end1 (point))
952: (funcall mover -1)
953: (setq start1 (point))
954: (transpose-subr-1))
955: (exchange-point-and-mark)))
956: (while (> arg 0)
957: (funcall mover -1)
958: (setq start1 (point))
959: (funcall mover 1)
960: (setq end1 (point))
961: (funcall mover 1)
962: (setq end2 (point))
963: (funcall mover -1)
964: (setq start2 (point))
965: (transpose-subr-1)
966: (goto-char end2)
967: (setq arg (1- arg)))
968: (while (< arg 0)
969: (funcall mover -1)
970: (setq start2 (point))
971: (funcall mover -1)
972: (setq start1 (point))
973: (funcall mover 1)
974: (setq end1 (point))
975: (funcall mover 1)
976: (setq end2 (point))
977: (transpose-subr-1)
978: (setq arg (1+ arg)))))
979:
980: (defun transpose-subr-1 ()
981: (if (> (min end1 end2) (max start1 start2))
982: (error "Don't have two things to transpose"))
983: (let ((word1 (buffer-substring start1 end1))
984: (word2 (buffer-substring start2 end2)))
985: (delete-region start2 end2)
986: (goto-char start2)
987: (insert word1)
988: (goto-char (if (< start1 start2) start1
989: (+ start1 (- (length word1) (length word2)))))
990: (delete-char (length word1))
991: (insert word2)))
992:
993: (defconst comment-column 32
994: "*Column to indent right-margin comments to.
995: Setting this variable automatically makes it local to the current buffer.")
996: (make-variable-buffer-local 'comment-column)
997:
998: (defconst comment-start nil
999: "*String to insert to start a new comment, or nil if no comment syntax defined.")
1000:
1001: (defconst comment-start-skip nil
1002: "*Regexp to match the start of a comment plus everything up to its body.
1003: If there are any \\(...\\) pairs, the comment delimiter text is held to begin
1004: at the place matched by the close of the first pair.")
1005:
1006: (defconst comment-end ""
1007: "*String to insert to end a new comment.
1008: Should be an empty string if comments are terminated by end-of-line.")
1009:
1010: (defconst comment-indent-hook
1011: '(lambda () comment-column)
1012: "Function to compute desired indentation for a comment
1013: given the character number it starts at.")
1014:
1015: (defun indent-for-comment ()
1016: "Indent this line's comment to comment column, or insert an empty comment."
1017: (interactive "*")
1018: (beginning-of-line 1)
1019: (if (null comment-start)
1020: (error "No comment syntax defined")
1021: (let* ((eolpos (save-excursion (end-of-line) (point)))
1022: cpos indent begpos)
1023: (if (re-search-forward comment-start-skip eolpos 'move)
1024: (progn (setq cpos (point-marker))
1025: ;; Find the start of the comment delimiter.
1026: ;; If there were paren-pairs in comment-start-skip,
1027: ;; position at the end of the first pair.
1028: (if (match-end 1)
1029: (goto-char (match-end 1))
1030: ;; If comment-start-skip matched a string with internal
1031: ;; whitespace (not final whitespace) then the delimiter
1032: ;; start at the end of that whitespace.
1033: ;; Otherwise, it starts at the beginning of what was matched.
1034: (skip-chars-backward " \t" (match-beginning 0))
1035: (skip-chars-backward "^ \t" (match-beginning 0)))))
1036: (setq begpos (point))
1037: ;; Compute desired indent.
1038: (if (= (current-column)
1039: (setq indent (funcall comment-indent-hook)))
1040: (goto-char begpos)
1041: ;; If that's different from current, change it.
1042: (skip-chars-backward " \t")
1043: (delete-region (point) begpos)
1044: (indent-to indent))
1045: ;; An existing comment?
1046: (if cpos
1047: (progn (goto-char cpos)
1048: (set-marker cpos nil))
1049: ;; No, insert one.
1050: (insert comment-start)
1051: (save-excursion
1052: (insert comment-end))))))
1053:
1054: (defun set-comment-column (arg)
1055: "Set the comment column based on point.
1056: With no arg, set the comment column to the current column.
1057: With just minus as arg, kill any comment on this line.
1058: With any other arg, set comment column to indentation of the previous comment
1059: and then align or create a comment on this line at that column."
1060: (interactive "P")
1061: (if (eq arg '-)
1062: (kill-comment nil)
1063: (if arg
1064: (progn
1065: (save-excursion
1066: (beginning-of-line)
1067: (re-search-backward comment-start-skip)
1068: (beginning-of-line)
1069: (re-search-forward comment-start-skip)
1070: (goto-char (match-beginning 0))
1071: (setq comment-column (current-column))
1072: (message "Comment column set to %d" comment-column))
1073: (indent-for-comment))
1074: (setq comment-column (current-column))
1075: (message "Comment column set to %d" comment-column))))
1076:
1077: (defun kill-comment (arg)
1078: "Kill the comment on this line, if any.
1079: With argument, kill comments on that many lines starting with this one."
1080: (interactive "P")
1081: (barf-if-buffer-read-only)
1082: (let ((count (prefix-numeric-value arg)))
1083: (beginning-of-line)
1084: (while (> count 0)
1085: (let ((eolpos (save-excursion (end-of-line) (point))))
1086: (if (re-search-forward comment-start-skip eolpos t)
1087: (progn
1088: (goto-char (match-beginning 0))
1089: (skip-chars-backward " \t")
1090: (kill-region (point) eolpos))))
1091: (if arg
1092: (forward-line 1))
1093: (setq count (1- count)))))
1094:
1095: (defun backward-word (arg)
1096: "Move backward until encountering the end of a word.
1097: With argument, do this that many times.
1098: In programs, it is faster to call forward-word with negative arg."
1099: (interactive "p")
1100: (forward-word (- arg)))
1101:
1102: (defun mark-word (arg)
1103: "Set mark arg words away from point."
1104: (interactive "p")
1105: (push-mark
1106: (save-excursion
1107: (forward-word arg)
1108: (point))))
1109:
1110: (defun kill-word (arg)
1111: "Kill characters forward until encountering the end of a word.
1112: With argument, do this that many times."
1113: (interactive "*p")
1114: (kill-region (point) (progn (forward-word arg) (point))))
1115:
1116: (defun backward-kill-word (arg)
1117: "Kill characters backward until encountering the end of a word.
1118: With argument, do this that many times."
1119: (interactive "*p")
1120: (kill-word (- arg)))
1121:
1122: (defconst fill-prefix nil
1123: "*String for filling to insert at front of new line, or nil for none.
1124: Setting this variable automatically makes it local to the current buffer.")
1125: (make-variable-buffer-local 'fill-prefix)
1126:
1127: (defun do-auto-fill ()
1128: (let ((fill-point
1129: (let ((opoint (point)))
1130: (save-excursion
1131: (move-to-column (1+ fill-column))
1132: (skip-chars-backward "^ \t\n")
1133: (if (bolp)
1134: (re-search-forward "[ \t]" opoint t))
1135: (skip-chars-backward " \t")
1136: (point)))))
1137: ;; If there is a space on the line before fill-point,
1138: ;; and nonspaces precede it, break the line there.
1139: (if (save-excursion
1140: (goto-char fill-point)
1141: (not (bolp)))
1142: ;; If point is at the fill-point, do not `save-excursion'.
1143: ;; Otherwise, if a comment prefix or fill-prefix is inserted,
1144: ;; point will end up before it rather than after it.
1145: (if (save-excursion
1146: (skip-chars-backward " \t")
1147: (= (point) fill-point))
1148: (indent-new-comment-line)
1149: (save-excursion
1150: (goto-char fill-point)
1151: (indent-new-comment-line))))))
1152:
1153: (defconst comment-multi-line nil
1154: "*Non-nil means \\[indent-new-comment-line] should continue same comment
1155: on new line, with no new terminator or starter.")
1156:
1157: (defun indent-new-comment-line ()
1158: "Break line at point and indent, continuing comment if presently within one.
1159: The body of the continued comment is indented under the previous comment line."
1160: (interactive "*")
1161: (let (comcol comstart)
1162: (skip-chars-backward " \t")
1163: (delete-region (point)
1164: (progn (skip-chars-forward " \t")
1165: (point)))
1166: (insert ?\n)
1167: (save-excursion
1168: (if (and comment-start-skip
1169: (let ((opoint (point)))
1170: (forward-line -1)
1171: (re-search-forward comment-start-skip opoint t)))
1172: ;; The old line is a comment.
1173: ;; Set WIN to the pos of the comment-start.
1174: ;; But if the comment is empty, look at preceding lines
1175: ;; to find one that has a nonempty comment.
1176: (let ((win (match-beginning 0)))
1177: (while (and (eolp) (not (bobp))
1178: (let (opoint)
1179: (beginning-of-line)
1180: (setq opoint (point))
1181: (forward-line -1)
1182: (re-search-forward comment-start-skip opoint t)))
1183: (setq win (match-beginning 0)))
1184: ;; Indent this line like what we found.
1185: (goto-char win)
1186: (setq comcol (current-column))
1187: (setq comstart (buffer-substring (point) (match-end 0))))))
1188: (if comcol
1189: (let ((comment-column comcol)
1190: (comment-start comstart)
1191: (comment-end comment-end))
1192: (and comment-end (not (equal comment-end ""))
1193: (if (not comment-multi-line)
1194: (progn
1195: (forward-char -1)
1196: (insert comment-end)
1197: (forward-char 1))
1198: (setq comment-column (+ comment-column (length comment-start))
1199: comment-start "")))
1200: (if (not (eolp))
1201: (setq comment-end ""))
1202: (insert ?\n)
1203: (forward-char -1)
1204: (indent-for-comment)
1205: (delete-char 1))
1206: (if fill-prefix
1207: (insert fill-prefix)
1208: (indent-according-to-mode)))))
1209:
1210: (defun auto-fill-mode (arg)
1211: "Toggle auto-fill mode.
1212: With arg, turn auto-fill mode on iff arg is positive.
1213: In auto-fill mode, inserting a space at a column beyond fill-column
1214: automatically breaks the line at a previous space."
1215: (interactive "P")
1216: (prog1 (setq auto-fill-hook
1217: (if (if (null arg)
1218: (not auto-fill-hook)
1219: (> (prefix-numeric-value arg) 0))
1220: 'do-auto-fill
1221: nil))
1222: ;; update mode-line
1223: (set-buffer-modified-p (buffer-modified-p))))
1224:
1225: (defun turn-on-auto-fill ()
1226: "Unconditionally turn on Auto Fill mode."
1227: (auto-fill-mode 1))
1228:
1229: (defun set-fill-column (arg)
1230: "Set fill-column to current column, or to argument if given.
1231: fill-column's value is separate for each buffer."
1232: (interactive "P")
1233: (setq fill-column (if (integerp arg) arg (current-column)))
1234: (message "fill-column set to %d" fill-column))
1235:
1236: (defun set-selective-display (arg)
1237: "Set selective-display to ARG; clear it if no arg.
1238: When selective-display is a number > 0,
1239: lines whose indentation is >= selective-display are not displayed.
1240: selective-display's value is separate for each buffer."
1241: (interactive "P")
1242: (if (eq selective-display t)
1243: (error "selective-display already in use for marked lines"))
1244: (setq selective-display
1245: (and arg (prefix-numeric-value arg)))
1246: (set-window-start (selected-window) (window-start (selected-window)))
1247: (princ "selective-display set to " t)
1248: (prin1 selective-display t)
1249: (princ "." t))
1250:
1251: (defun overwrite-mode (arg)
1252: "Toggle overwrite mode.
1253: With arg, turn overwrite mode on iff arg is positive.
1254: In overwrite mode, printing characters typed in replace existing text
1255: on a one-for-one basis, rather than pushing it to the right."
1256: (interactive "P")
1257: (setq overwrite-mode
1258: (if (null arg) (not overwrite-mode)
1259: (> (prefix-numeric-value arg) 0)))
1260: (set-buffer-modified-p (buffer-modified-p))) ;No-op, but updates mode line.
1261:
1262: (defconst blink-matching-paren t
1263: "*Non-nil means show matching open-paren when close-paren is inserted.")
1264:
1265: (defconst blink-matching-paren-distance 4000
1266: "*If non-nil, is maximum distance to search for matching open-paren
1267: when close-paren is inserted.")
1268:
1269: (defun blink-matching-open ()
1270: "Move cursor momentarily to the beginning of the sexp before point."
1271: (and (> (point) (1+ (point-min)))
1272: (/= (char-syntax (char-after (- (point) 2))) ?\\ )
1273: blink-matching-paren
1274: (let* ((oldpos (point))
1275: (blinkpos)
1276: (mismatch))
1277: (save-excursion
1278: (save-restriction
1279: (if blink-matching-paren-distance
1280: (narrow-to-region (max (point-min)
1281: (- (point) blink-matching-paren-distance))
1282: oldpos))
1283: (condition-case ()
1284: (setq blinkpos (scan-sexps oldpos -1))
1285: (error nil)))
1286: (and blinkpos (/= (char-syntax (char-after blinkpos))
1287: ?\$)
1288: (setq mismatch
1289: (/= (char-after (1- oldpos))
1290: (logand (lsh (aref (syntax-table)
1291: (char-after blinkpos))
1292: -8)
1293: 255))))
1294: (if mismatch (setq blinkpos nil))
1295: (if blinkpos
1296: (progn
1297: (goto-char blinkpos)
1298: (if (pos-visible-in-window-p)
1299: (sit-for 1)
1300: (goto-char blinkpos)
1301: (message
1302: "Matches %s"
1303: (if (save-excursion
1304: (skip-chars-backward " \t")
1305: (not (bolp)))
1306: (buffer-substring (progn (beginning-of-line) (point))
1307: (1+ blinkpos))
1308: (buffer-substring blinkpos
1309: (progn
1310: (forward-char 1)
1311: (skip-chars-forward "\n \t")
1312: (end-of-line)
1313: (point)))))))
1314: (cond (mismatch
1315: (message "Mismatched parentheses"))
1316: ((not blink-matching-paren-distance)
1317: (message "Unmatched parenthesis"))))))))
1318:
1319: ;Turned off because it makes dbx bomb out.
1320: (setq blink-paren-hook 'blink-matching-open)
1321:
1322: ; this is just something for the luser to see in a keymap -- this is not
1323: ; how quitting works normally!
1324: (defun keyboard-quit ()
1325: "Signal a quit condition."
1326: (interactive)
1327: (signal 'quit nil))
1328:
1329: (define-key global-map "\C-g" 'keyboard-quit)
1330:
1331: (defun set-variable (var val)
1332: "Set VARIABLE to VALUE. VALUE is a Lisp object.
1333: When using this interactively, supply a Lisp expression for VALUE.
1334: If you want VALUE to be a string, you must surround it with doublequotes."
1335: (interactive
1336: (let* ((var (read-variable "Set variable: "))
1337: (minibuffer-help-form
1338: '(funcall myhelp))
1339: (myhelp
1340: (function
1341: (lambda ()
1342: (with-output-to-temp-buffer "*Help*"
1343: (prin1 var)
1344: (princ "\nDocumentation:\n")
1345: (princ (substring (documentation-property var 'variable-documentation)
1346: 1))
1347: (if (boundp var)
1348: (let ((print-length 20))
1349: (princ "\n\nCurrent value: ")
1350: (prin1 (symbol-value var))))
1351: nil)))))
1352: (list var
1353: (eval-minibuffer (format "Set %s to value: " var)))))
1354: (set var val))
1355:
1356: ;These commands are defined in editfns.c
1357: ;but they are not assigned to keys there.
1358: (put 'narrow-to-region 'disabled t)
1359: (define-key ctl-x-map "n" 'narrow-to-region)
1360: (define-key ctl-x-map "w" 'widen)
1361:
1362: (define-key global-map "\C-j" 'newline-and-indent)
1363: (define-key global-map "\C-m" 'newline)
1364: (define-key global-map "\C-o" 'open-line)
1365: (define-key esc-map "\C-o" 'split-line)
1366: (define-key global-map "\C-q" 'quoted-insert)
1367: (define-key esc-map "^" 'delete-indentation)
1368: (define-key esc-map "\\" 'delete-horizontal-space)
1369: (define-key esc-map "m" 'back-to-indentation)
1370: (define-key ctl-x-map "\C-o" 'delete-blank-lines)
1371: (define-key esc-map " " 'just-one-space)
1372: (define-key esc-map "z" 'zap-to-char)
1373: (define-key esc-map "=" 'count-lines-region)
1374: (define-key ctl-x-map "=" 'what-cursor-position)
1375: (define-key esc-map "\e" 'eval-expression)
1376: (define-key ctl-x-map "\e" 'repeat-complex-command)
1377: (define-key ctl-x-map "u" 'advertised-undo)
1378: (define-key global-map "\C-_" 'undo)
1379: (define-key esc-map "!" 'shell-command)
1380: (define-key esc-map "|" 'shell-command-on-region)
1381:
1382: (define-key global-map "\C-u" 'universal-argument)
1383: (let ((i ?0))
1384: (while (<= i ?9)
1385: (define-key esc-map (char-to-string i) 'digit-argument)
1386: (setq i (1+ i))))
1387: (define-key esc-map "-" 'negative-argument)
1388:
1389: (define-key global-map "\C-k" 'kill-line)
1390: (define-key global-map "\C-w" 'kill-region)
1391: (define-key esc-map "w" 'copy-region-as-kill)
1392: (define-key esc-map "\C-w" 'append-next-kill)
1393: (define-key global-map "\C-y" 'yank)
1394: (define-key esc-map "y" 'yank-pop)
1395:
1396: (define-key ctl-x-map "a" 'append-to-buffer)
1397:
1398: (define-key global-map "\C-@" 'set-mark-command)
1399: (define-key ctl-x-map "\C-x" 'exchange-point-and-mark)
1400:
1401: (define-key global-map "\C-n" 'next-line)
1402: (define-key global-map "\C-p" 'previous-line)
1403: (define-key ctl-x-map "\C-n" 'set-goal-column)
1404:
1405: (define-key global-map "\C-t" 'transpose-chars)
1406: (define-key esc-map "t" 'transpose-words)
1407: (define-key esc-map "\C-t" 'transpose-sexps)
1408: (define-key ctl-x-map "\C-t" 'transpose-lines)
1409:
1410: (define-key esc-map ";" 'indent-for-comment)
1411: (define-key esc-map "j" 'indent-new-comment-line)
1412: (define-key esc-map "\C-j" 'indent-new-comment-line)
1413: (define-key ctl-x-map ";" 'set-comment-column)
1414: (define-key ctl-x-map "f" 'set-fill-column)
1415: (define-key ctl-x-map "$" 'set-selective-display)
1416:
1417: (define-key esc-map "@" 'mark-word)
1418: (define-key esc-map "f" 'forward-word)
1419: (define-key esc-map "b" 'backward-word)
1420: (define-key esc-map "d" 'kill-word)
1421: (define-key esc-map "\177" 'backward-kill-word)
1422:
1423: (define-key esc-map "<" 'beginning-of-buffer)
1424: (define-key esc-map ">" 'end-of-buffer)
1425: (define-key ctl-x-map "h" 'mark-whole-buffer)
1426: (define-key esc-map "\\" 'delete-horizontal-space)
1427:
1428: (fset 'mode-specific-command-prefix (make-sparse-keymap))
1429: (defconst mode-specific-map (symbol-function 'mode-specific-command-prefix)
1430: "Keymap for characters following C-c.")
1431: (define-key global-map "\C-c" 'mode-specific-command-prefix)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.