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