Return to simple.el CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp

Annotation of 43BSDReno/contrib/emacs-18.55/lisp/simple.el, revision 1.1

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.