|
|
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.