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