lisp/simple.el

   1 ;;; simple.el --- basic editing commands for Emacs
   2
   3 ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; GNU Emacs is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 2, or (at your option)
  10 ;; any later version.
  11
  12 ;; GNU Emacs is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20
  21 ;;; Code:
  22
  23 (defun open-line (arg)
  24   "Insert a newline and leave point before it.  If there is a fill
  25 prefix, inserts the fill prefix after the newline that it inserts.
  26 With arg, inserts that many newlines."
  27   (interactive "*p")
  28   (let ((flag (and (bolp) (not (bobp)))))
  29     (if flag (forward-char -1))
  30     (while (> arg 0)
  31       (save-excursion
  32         (insert ?\n)
  33         (if fill-prefix (insert fill-prefix)))
  34       (setq arg (1- arg)))
  35     (if flag (forward-char 1))))
  36
  37 (defun split-line ()
  38   "Split current line, moving portion beyond point vertically down."
  39   (interactive "*")
  40   (skip-chars-forward " \t")
  41   (let ((col (current-column))
  42         (pos (point)))
  43     (insert ?\n)
  44     (indent-to col 0)
  45     (goto-char pos)))
  46
  47 (defun quoted-insert (arg)
  48   "Read next input character and insert it.
  49 Useful for inserting control characters.
  50 You may also type up to 3 octal digits, to insert a character with that code"
  51   (interactive "*p")
  52   (let ((char (read-quoted-char)))
  53     (while (> arg 0)
  54       (insert char)
  55       (setq arg (1- arg)))))
  56
  57 (defun delete-indentation (&optional arg)
  58   "Join this line to previous and fix up whitespace at join.
  59 If there is a fill prefix, delete it from the beginning of this line.
  60 With argument, join this line to following line."
  61   (interactive "*P")
  62   (beginning-of-line)
  63   (if arg (forward-line 1))
  64   (if (eq (preceding-char) ?\n)
  65       (progn
  66         (delete-region (point) (1- (point)))
  67         ;; If the second line started with the fill prefix,
  68         ;; delete the prefix.
  69         (if (and fill-prefix
  70                  (string= fill-prefix
  71                           (buffer-substring (point)
  72                                             (+ (point) (length fill-prefix)))))
  73             (delete-region (point) (+ (point) (length fill-prefix))))
  74         (fixup-whitespace))))
  75
  76 (defun fixup-whitespace ()
  77   "Fixup white space between objects around point.
  78 Leave one space or none, according to the context."
  79   (interactive "*")
  80   (save-excursion
  81     (delete-horizontal-space)
  82     (if (or (looking-at "^\\|\\s)")
  83             (save-excursion (forward-char -1)
  84                             (looking-at "$\\|\\s(\\|\\s'")))
  85         nil
  86       (insert ?\ ))))
  87
  88 (defun delete-horizontal-space ()
  89   "Delete all spaces and tabs around point."
  90   (interactive "*")
  91   (skip-chars-backward " \t")
  92   (delete-region (point) (progn (skip-chars-forward " \t") (point))))
  93
  94 (defun just-one-space ()
  95   "Delete all spaces and tabs around point, leaving one space."
  96   (interactive "*")
  97   (skip-chars-backward " \t")
  98   (if (= (following-char) ? )
  99       (forward-char 1)
 100     (insert ? ))
 101   (delete-region (point) (progn (skip-chars-forward " \t") (point))))
 102
 103 (defun delete-blank-lines ()
 104   "On blank line, delete all surrounding blank lines, leaving just one.
 105 On isolated blank line, delete that one.
 106 On nonblank line, delete all blank lines that follow it."
 107   (interactive "*")
 108   (let (thisblank singleblank)
 109     (save-excursion
 110       (beginning-of-line)
 111       (setq thisblank (looking-at "[ \t]*$"))
 112       ;; Set singleblank if there is just one blank line here.
 113       (setq singleblank
 114             (and thisblank
 115                  (not (looking-at "[ \t]*\n[ \t]*$"))
 116                  (or (bobp)
 117                      (progn (forward-line -1)
 118                             (not (looking-at "[ \t]*$")))))))
 119     ;; Delete preceding blank lines, and this one too if it's the only one.
 120     (if thisblank
 121         (progn
 122           (beginning-of-line)
 123           (if singleblank (forward-line 1))
 124           (delete-region (point)
 125                          (if (re-search-backward "[^ \t\n]" nil t)
 126                              (progn (forward-line 1) (point))
 127                            (point-min)))))
 128     ;; Delete following blank lines, unless the current line is blank
 129     ;; and there are no following blank lines.
 130     (if (not (and thisblank singleblank))
 131         (save-excursion
 132           (end-of-line)
 133           (forward-line 1)
 134           (delete-region (point)
 135                          (if (re-search-forward "[^ \t\n]" nil t)
 136                              (progn (beginning-of-line) (point))
 137                            (point-max)))))
 138     ;; Handle the special case where point is followed by newline and eob.
 139     ;; Delete the line, leaving point at eob.
 140     (if (looking-at "^[ \t]*\n\\'")
 141         (delete-region (point) (point-max)))))
 142
 143 (defun back-to-indentation ()
 144   "Move point to the first non-whitespace character on this line."
 145   (interactive)
 146   (beginning-of-line 1)
 147   (skip-chars-forward " \t"))
 148
 149 (defun newline-and-indent ()
 150   "Insert a newline, then indent according to major mode.
 151 Indentation is done using the current indent-line-function.
 152 In programming language modes, this is the same as TAB.
 153 In some text modes, where TAB inserts a tab, this indents to the
 154 specified left-margin column."
 155   (interactive "*")
 156   (delete-region (point) (progn (skip-chars-backward " \t") (point)))
 157   (newline)
 158   (indent-according-to-mode))
 159
 160 (defun reindent-then-newline-and-indent ()
 161   "Reindent current line, insert newline, then indent the new line.
 162 Indentation of both lines is done according to the current major mode,
 163 which means that the current value of indent-line-function is called.
 164 In programming language modes, this is the same as TAB.
 165 In some text modes, where TAB inserts a tab, this indents to the
 166 specified left-margin column."
 167   (interactive "*")
 168   (save-excursion
 169     (delete-region (point) (progn (skip-chars-backward " \t") (point)))
 170     (indent-according-to-mode))
 171   (newline)
 172   (indent-according-to-mode))
 173
 174 ;; Internal subroutine of delete-char
 175 (defun kill-forward-chars (arg)
 176   (if (listp arg) (setq arg (car arg)))
 177   (if (eq arg '-) (setq arg -1))
 178   (kill-region (point) (+ (point) arg)))
 179
 180 ;; Internal subroutine of backward-delete-char
 181 (defun kill-backward-chars (arg)
 182   (if (listp arg) (setq arg (car arg)))
 183   (if (eq arg '-) (setq arg -1))
 184   (kill-region (point) (- (point) arg)))
 185
 186 (defun backward-delete-char-untabify (arg &optional killp)
 187   "Delete characters backward, changing tabs into spaces.
 188 Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
 189 Interactively, ARG is the prefix arg (default 1)
 190 and KILLP is t if prefix arg is was specified."
 191   (interactive "*p\nP")
 192   (let ((count arg))
 193     (save-excursion
 194       (while (and (> count 0) (not (bobp)))
 195         (if (= (preceding-char) ?\t)
 196             (let ((col (current-column)))
 197               (forward-char -1)
 198               (setq col (- col (current-column)))
 199               (insert-char ?\ col)
 200               (delete-char 1)))
 201         (forward-char -1)
 202         (setq count (1- count)))))
 203   (delete-backward-char arg killp)
 204   ;; In overwrite mode, back over columns while clearing them out,
 205   ;; unless at end of line.
 206   (and overwrite-mode (not (eolp))
 207        (save-excursion (insert-char ?\  arg))))
 208
 209 (defun zap-to-char (arg char)
 210   "Kill up to and including ARG'th occurrence of CHAR.
 211 Goes backward if ARG is negative; error if CHAR not found."
 212   (interactive "p\ncZap to char: ")
 213   (kill-region (point) (progn
 214                          (search-forward (char-to-string char) nil nil arg)
 215 ;                        (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
 216                          (point))))
 217
 218 (defun beginning-of-buffer (&optional arg)
 219   "Move point to the beginning of the buffer; leave mark at previous position.
 220 With arg N, put point N/10 of the way from the true beginning.
 221 Don't use this in Lisp programs!
 222 \(goto-char (point-min)) is faster and avoids clobbering the mark."
 223   (interactive "P")
 224   (push-mark)
 225   (goto-char (if arg
 226                  (if (> (buffer-size) 10000)
 227                      ;; Avoid overflow for large buffer sizes!
 228                      (* (prefix-numeric-value arg)
 229                         (/ (buffer-size) 10))
 230                    (/ (+ 10 (* (buffer-size) (prefix-numeric-value arg))) 10))
 231                (point-min)))
 232   (if arg (forward-line 1)))
 233
 234 (defun end-of-buffer (&optional arg)
 235   "Move point to the end of the buffer; leave mark at previous position.
 236 With arg N, put point N/10 of the way from the true end.
 237 Don't use this in Lisp programs!
 238 \(goto-char (point-max)) is faster and avoids clobbering the mark."
 239   (interactive "P")
 240   (push-mark)
 241   (goto-char (if arg
 242                  (- (1+ (buffer-size))
 243                     (if (> (buffer-size) 10000)
 244                         ;; Avoid overflow for large buffer sizes!
 245                         (* (prefix-numeric-value arg)
 246                            (/ (buffer-size) 10))
 247                       (/ (* (buffer-size) (prefix-numeric-value arg)) 10)))
 248                (point-max)))
 249   ;; If we went to a place in the middle of the buffer,
 250   ;; adjust it to the beginning of a line.
 251   (if arg (forward-line 1)
 252     ;; If the end of the buffer is not already on the screen,
 253     ;; then scroll specially to put it near, but not at, the bottom.
 254     (if (let ((old-point (point)))
 255           (save-excursion
 256                     (goto-char (window-start))
 257                     (vertical-motion (window-height))
 258                     (< (point) old-point)))
 259         (recenter -3))))
 260
 261 (defun mark-whole-buffer ()
 262   "Put point at beginning and mark at end of buffer.
 263 You probably should not use this function in Lisp programs;
 264 it is usually a mistake for a Lisp function to use any subroutine
 265 that uses or sets the mark."
 266   (interactive)
 267   (push-mark (point))
 268   (push-mark (point-max))
 269   (goto-char (point-min)))
 270
 271 (defun count-lines-region (start end)
 272   "Print number of lines and charcters in the region."
 273   (interactive "r")
 274   (message "Region has %d lines, %d characters"
 275            (count-lines start end) (- end start)))
 276
 277 (defun what-line ()
 278   "Print the current line number (in the buffer) of point."
 279   (interactive)
 280   (save-restriction
 281     (widen)
 282     (save-excursion
 283       (beginning-of-line)
 284       (message "Line %d"
 285                (1+ (count-lines 1 (point)))))))
 286
 287 (defun count-lines (start end)
 288   "Return number of lines between START and END.
 289 This is usually the number of newlines between them,
 290 but will be one more if START is not equal to END
 291 and the greater of them is not at the start of a line."
 292   (save-excursion
 293     (save-restriction
 294       (narrow-to-region start end)
 295       (goto-char (point-min))
 296       (if (eq selective-display t)
 297           (let ((done 0))
 298             (while (re-search-forward "[\n\C-m]" nil t 40)
 299               (setq done (+ 40 done)))
 300             (while (re-search-forward "[\n\C-m]" nil t 1)
 301               (setq done (+ 1 done)))
 302             done)
 303         (- (buffer-size) (forward-line (buffer-size)))))))
 304
 305 (defun what-cursor-position ()
 306   "Print info on cursor position (on screen and within buffer)."
 307   (interactive)
 308   (let* ((char (following-char))
 309          (beg (point-min))
 310          (end (point-max))
 311          (pos (point))
 312          (total (buffer-size))
 313          (percent (if (> total 50000)
 314                       ;; Avoid overflow from multiplying by 100!
 315                       (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
 316                     (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
 317          (hscroll (if (= (window-hscroll) 0)
 318                       ""
 319                     (format " Hscroll=%d" (window-hscroll))))
 320          (col (current-column)))
 321     (if (= pos end)
 322         (if (or (/= beg 1) (/= end (1+ total)))
 323             (message "point=%d of %d(%d%%) <%d - %d>  column %d %s"
 324                      pos total percent beg end col hscroll)
 325           (message "point=%d of %d(%d%%)  column %d %s"
 326                    pos total percent col hscroll))
 327       (if (or (/= beg 1) (/= end (1+ total)))
 328           (message "Char: %s (0%o)  point=%d of %d(%d%%) <%d - %d>  column %d %s"
 329                    (single-key-description char) char pos total percent beg end col hscroll)
 330         (message "Char: %s (0%o)  point=%d of %d(%d%%)  column %d %s"
 331                  (single-key-description char) char pos total percent col hscroll)))))
 332
 333 (defun fundamental-mode ()
 334   "Major mode not specialized for anything in particular.
 335 Other major modes are defined by comparison with this one."
 336   (interactive)
 337   (kill-all-local-variables))
 338
 339 (put 'eval-expression 'disabled t)
 340
 341 ;; We define this, rather than making  eval  interactive,
 342 ;; for the sake of completion of names like eval-region, eval-current-buffer.
 343 (defun eval-expression (expression)
 344   "Evaluate EXPRESSION and print value in minibuffer.
 345 Value is also consed on to front of the variable `values'."
 346   (interactive "xEval: ")
 347   (setq values (cons (eval expression) values))
 348   (prin1 (car values) t))
 349
 350 (defun edit-and-eval-command (prompt command)
 351   "Prompting with PROMPT, let user edit COMMAND and eval result.
 352 COMMAND is a Lisp expression.  Let user edit that expression in
 353 the minibuffer, then read and evaluate the result."
 354   (let ((command (read-minibuffer prompt
 355                                   (prin1-to-string command))))
 356     ;; Add edited command to command history, unless redundant.
 357     (or (equal command (car command-history))
 358         (setq command-history (cons command command-history)))
 359     (eval command)))
 360
 361 (defun repeat-complex-command (arg)
 362   "Edit and re-evaluate last complex command, or ARGth from last.
 363 A complex command is one which used the minibuffer.
 364 The command is placed in the minibuffer as a Lisp form for editing.
 365 The result is executed, repeating the command as changed.
 366 If the command has been changed or is not the most recent previous command
 367 it is added to the front of the command history.
 368 You can use the minibuffer history commands \\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
 369 to get different commands to edit and resubmit."
 370   (interactive "p")
 371   (let ((elt (nth (1- arg) command-history))
 372         (minibuffer-history-position arg)
 373         (minibuffer-history-sexp-flag t)
 374         newcmd)
 375     (if elt
 376         (let ((minibuffer-history-variable ' command-history))
 377           (setq newcmd (read-from-minibuffer "Redo: "
 378                                              (prin1-to-string elt)
 379                                              minibuffer-local-map
 380                                              t
 381                                              (cons 'command-history
 382                                                    arg)))
 383           ;; If command to be redone does not match front of history,
 384           ;; add it to the history.
 385           (or (equal newcmd (car command-history))
 386               (setq command-history (cons newcmd command-history)))
 387           (eval newcmd))
 388       (ding))))
 389 \f
 390 (defvar minibuffer-history nil)
 391 (defvar minibuffer-history-sexp-flag nil)
 392 (setq minibuffer-history-variable 'minibuffer-history)
 393 (setq minibuffer-history-position nil)
 394
 395 (mapcar
 396  (function (lambda (key-and-command)
 397              (mapcar
 398               (function (lambda (keymap)
 399                           (define-key (symbol-value keymap)
 400                             (car key-and-command)
 401                             (cdr key-and-command))))
 402               '(minibuffer-local-map
 403                 minibuffer-local-ns-map
 404                 minibuffer-local-completion-map
 405                 minibuffer-local-must-match-map))))
 406  '(("\en" . next-history-element) ([next] . next-history-element)
 407    ("\ep" . previous-history-element) ([prior] . previous-history-element)
 408    ("\er" . previous-matching-history-element)
 409    ("\es" . next-matching-history-element)))
 410
 411 (put 'previous-matching-history-element 'enable-recursive-minibuffers t)
 412 (defun previous-matching-history-element (regexp n)
 413   (interactive "sPrevious element matching (regexp): \np")
 414   (let ((history (symbol-value minibuffer-history-variable))
 415         prevpos
 416         (pos minibuffer-history-position))
 417     (while (/= n 0)
 418       (setq prevpos pos)
 419       (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
 420       (if (= pos prevpos)
 421           (error (if (= pos 1)
 422                      "No later matching history item"
 423                    "No earlier matching history item")))
 424       (if (string-match regexp
 425                         (if minibuffer-history-sexp-flag
 426                             (prin1-to-string (nth (1- pos) history))
 427                           (nth (1- pos) history)))
 428           (setq n (+ n (if (< n 0) -1 1)))))
 429     (setq minibuffer-history-position pos)
 430     (erase-buffer)
 431     (let ((elt (nth (1- pos) history)))
 432       (insert (if minibuffer-history-sexp-flag
 433                   (prin1-to-string elt)
 434                 elt)))
 435       (goto-char (point-min))))
 436
 437 (put 'next-matching-history-element 'enable-recursive-minibuffers t)
 438 (defun next-matching-history-element (regexp n)
 439   (interactive "sNext element matching (regexp): \np")
 440   (previous-matching-history-element regexp (- n)))
 441
 442 (defun next-history-element (n)
 443   "Insert the next element of the minibuffer history into the minibuffer."
 444   (interactive "p")
 445   (let ((narg (min (max 1 (- minibuffer-history-position n))
 446                    (length (symbol-value minibuffer-history-variable)))))
 447     (if (= minibuffer-history-position narg)
 448         (error (if (= minibuffer-history-position 1)
 449                    "End of history; no next item"
 450                  "Beginning of history; no preceding item"))
 451       (erase-buffer)
 452       (setq minibuffer-history-position narg)
 453       (let ((elt (nth (1- minibuffer-history-position)
 454                       (symbol-value minibuffer-history-variable))))
 455         (insert
 456          (if minibuffer-history-sexp-flag
 457              (prin1-to-string elt)
 458            elt)))
 459       (goto-char (point-min)))))
 460
 461 (defun previous-history-element (n)
 462   "Inserts the previous element of `command-history' into the minibuffer."
 463   (interactive "p")
 464   (next-history-element (- n)))
 465 \f
 466 (defun goto-line (arg)
 467   "Goto line ARG, counting from line 1 at beginning of buffer."
 468   (interactive "NGoto line: ")
 469   (save-restriction
 470     (widen)
 471     (goto-char 1)
 472     (if (eq selective-display t)
 473         (re-search-forward "[\n\C-m]" nil 'end (1- arg))
 474       (forward-line (1- arg)))))
 475
 476 ;Put this on C-x u, so we can force that rather than C-_ into startup msg
 477 (fset 'advertised-undo 'undo)
 478
 479 (defun undo (&optional arg)
 480   "Undo some previous changes.
 481 Repeat this command to undo more changes.
 482 A numeric argument serves as a repeat count."
 483   (interactive "*p")
 484   (let ((modified (buffer-modified-p)))
 485     (or (eq (selected-window) (minibuffer-window))
 486         (message "Undo!"))
 487     (or (eq last-command 'undo)
 488         (progn (undo-start)
 489                (undo-more 1)))
 490     (setq this-command 'undo)
 491     (undo-more (or arg 1))
 492     (and modified (not (buffer-modified-p))
 493          (delete-auto-save-file-if-necessary))))
 494
 495 (defun undo-start ()
 496   "Move pending-undo-list to front of undo records.
 497 The next call to undo-more will undo the most recently made change."
 498   (if (eq buffer-undo-list t)
 499       (error "No undo information in this buffer"))
 500   (setq pending-undo-list buffer-undo-list))
 501
 502 (defun undo-more (count)
 503   "Undo back N undo-boundaries beyond what was already undone recently.
 504 Call undo-start to get ready to undo recent changes,
 505 then call undo-more one or more times to undo them."
 506   (or pending-undo-list
 507       (error "No further undo information"))
 508   (setq pending-undo-list (primitive-undo count pending-undo-list)))
 509
 510 (defvar last-shell-command "")
 511 (defvar last-shell-command-on-region "")
 512
 513 (defun shell-command (command &optional flag)
 514   "Execute string COMMAND in inferior shell; display output, if any.
 515 If COMMAND ends in ampersand, execute it asynchronously.
 516
 517 Optional second arg non-nil (prefix arg, if interactive)
 518 means insert output in current buffer after point (leave mark after it).
 519 This cannot be done asynchronously."
 520   (interactive (list (read-string "Shell command: " last-shell-command)
 521                      current-prefix-arg))
 522   (if flag
 523       (progn (barf-if-buffer-read-only)
 524              (push-mark)
 525              ;; We do not use -f for csh; we will not support broken use of
 526              ;; .cshrcs.  Even the BSD csh manual says to use
 527              ;; "if ($?prompt) exit" before things which are not useful
 528              ;; non-interactively.  Besides, if someone wants their other
 529              ;; aliases for shell commands then they can still have them.
 530              (call-process shell-file-name nil t nil
 531                            "-c" command)
 532              (exchange-point-and-mark))
 533     ;; Preserve the match data in case called from a program.
 534     (let ((data (match-data)))
 535       (unwind-protect
 536           (if (string-match "[ \t]*&[ \t]*$" command)
 537               ;; Command ending with ampersand means asynchronous.
 538               (let ((buffer (get-buffer-create "*shell-command*"))
 539                     (directory default-directory)
 540                     proc)
 541                 ;; Remove the ampersand.
 542                 (setq command (substring command 0 (match-beginning 0)))
 543                 ;; If will kill a process, query first.
 544                 (setq proc (get-buffer-process buffer))
 545                 (if proc
 546                     (if (yes-or-no-p "A command is running.  Kill it? ")
 547                         (kill-process proc)
 548                       (error "Shell command in progress")))
 549                 (save-excursion
 550                   (set-buffer buffer)
 551                   (erase-buffer)
 552                   (display-buffer buffer)
 553                   (setq default-directory directory)
 554                   (setq proc (start-process "Shell" buffer
 555                                             shell-file-name "-c" command))
 556                   (setq mode-line-process '(": %s"))
 557                   (set-process-sentinel proc 'shell-command-sentinel)
 558                   (set-process-filter proc 'shell-command-filter)
 559                   ))
 560             (shell-command-on-region (point) (point) command nil))
 561         (store-match-data data)))))
 562
 563 ;; We have a sentinel to prevent insertion of a termination message
 564 ;; in the buffer itself.
 565 (defun shell-command-sentinel (process signal)
 566   (if (memq (process-status process) '(exit signal))
 567       (progn
 568         (message "%s: %s."
 569                  (car (cdr (cdr (process-command process))))
 570                  (substring signal 0 -1))
 571         (save-excursion
 572           (set-buffer (process-buffer process))
 573           (setq mode-line-process nil))
 574         (delete-process process))))
 575
 576 (defun shell-command-filter (proc string)
 577   ;; Do save-excursion by hand so that we can leave point numerically unchanged
 578   ;; despite an insertion immediately after it.
 579   (let* ((obuf (current-buffer))
 580          (buffer (process-buffer proc))
 581          opoint
 582          (window (get-buffer-window buffer))
 583          (pos (window-start window)))
 584     (unwind-protect
 585         (progn
 586           (set-buffer buffer)
 587           (setq opoint (point))
 588           (goto-char (point-max))
 589           (insert-before-markers string))
 590       ;; insert-before-markers moved this marker: set it back.
 591       (set-window-start window pos)
 592       ;; Finish our save-excursion.
 593       (goto-char opoint)
 594       (set-buffer obuf))))
 595
 596 (defun shell-command-on-region (start end command &optional flag interactive)
 597   "Execute string COMMAND in inferior shell with region as input.
 598 Normally display output (if any) in temp buffer `*Shell Command Output*';
 599 Prefix arg means replace the region with it.
 600 Noninteractive args are START, END, COMMAND, FLAG.
 601 Noninteractively FLAG means insert output in place of text from START to END,
 602 and put point at the end, but don't alter the mark.
 603
 604 If the output is one line, it is displayed in the echo area,
 605 but it is nonetheless available in buffer `*Shell Command Output*'
 606 even though that buffer is not automatically displayed.  If there is no output
 607 or output is inserted in the current buffer then `*Shell Command Output*' is
 608 deleted."
 609   (interactive (list (min (point) (mark)) (max (point) (mark))
 610                      (read-string "Shell command on region: "
 611                                   last-shell-command-on-region)
 612                      current-prefix-arg
 613                      (prefix-numeric-value current-prefix-arg)))
 614   (if flag
 615       ;; Replace specified region with output from command.
 616       (let ((swap (and interactive (< (point) (mark)))))
 617         ;; Don't muck with mark
 618         ;; unless called interactively.
 619         (and interactive (push-mark))
 620         (call-process-region start end shell-file-name t t nil
 621                              "-c" command)
 622         (if (get-buffer "*Shell Command Output*")
 623             (kill-buffer "*Shell Command Output*"))
 624         (and interactive swap (exchange-point-and-mark)))
 625     ;; No prefix argument: put the output in a temp buffer,
 626     ;; replacing its entire contents.
 627     (let ((buffer (get-buffer-create "*Shell Command Output*")))
 628       (if (eq buffer (current-buffer))
 629           ;; If the input is the same buffer as the output,
 630           ;; delete everything but the specified region,
 631           ;; then replace that region with the output.
 632           (progn (delete-region end (point-max))
 633                  (delete-region (point-min) start)
 634                  (call-process-region (point-min) (point-max)
 635                                       shell-file-name t t nil
 636                                       "-c" command))
 637         ;; Clear the output buffer, then run the command with output there.
 638         (save-excursion
 639           (set-buffer buffer)
 640           (erase-buffer))
 641         (call-process-region start end shell-file-name
 642                              nil buffer nil
 643                              "-c" command))
 644       ;; Report the amount of output.
 645       (let ((lines (save-excursion
 646                      (set-buffer buffer)
 647                      (if (= (buffer-size) 0)
 648                          0
 649                        (count-lines (point-min) (point-max))))))
 650         (cond ((= lines 0)
 651                (message "(Shell command completed with no output)")
 652                (kill-buffer "*Shell Command Output*"))
 653               ((= lines 1)
 654                (message "%s"
 655                         (save-excursion
 656                           (set-buffer buffer)
 657                           (goto-char (point-min))
 658                           (buffer-substring (point)
 659                                             (progn (end-of-line) (point))))))
 660               (t
 661                (set-window-start (display-buffer buffer) 1)))))))
 662 \f
 663 (defun universal-argument ()
 664   "Begin a numeric argument for the following command.
 665 Digits or minus sign following \\[universal-argument] make up the numeric argument.
 666 \\[universal-argument] following the digits or minus sign ends the argument.
 667 \\[universal-argument] without digits or minus sign provides 4 as argument.
 668 Repeating \\[universal-argument] without digits or minus sign
 669  multiplies the argument by 4 each time."
 670   (interactive nil)
 671   (let ((factor 4)
 672         key)
 673 ;;    (describe-arg (list factor) 1)
 674     (setq key (read-key-sequence nil t))
 675     (while (equal (key-binding key) 'universal-argument)
 676       (setq factor (* 4 factor))
 677 ;;      (describe-arg (list factor) 1)
 678       (setq key (read-key-sequence nil t)))
 679     (prefix-arg-internal key factor nil)))
 680
 681 (defun prefix-arg-internal (key factor value)
 682   (let ((sign 1))
 683     (if (and (numberp value) (< value 0))
 684         (setq sign -1 value (- value)))
 685     (if (eq value '-)
 686         (setq sign -1 value nil))
 687 ;;    (describe-arg value sign)
 688     (while (equal key "-")
 689       (setq sign (- sign) factor nil)
 690 ;;      (describe-arg value sign)
 691       (setq key (read-key-sequence nil t)))
 692     (while (and (= (length key) 1)
 693                 (not (string< key "0"))
 694                 (not (string< "9" key)))
 695       (setq value (+ (* (if (numberp value) value 0) 10)
 696                      (- (aref key 0) ?0))
 697             factor nil)
 698 ;;      (describe-arg value sign)
 699       (setq key (read-key-sequence nil t)))
 700     (setq prefix-arg
 701           (cond (factor (list factor))
 702                 ((numberp value) (* value sign))
 703                 ((= sign -1) '-)))
 704     ;; Calling universal-argument after digits
 705     ;; terminates the argument but is ignored.
 706     (if (eq (key-binding key) 'universal-argument)
 707         (progn
 708           (describe-arg value sign)
 709           (setq key (read-key-sequence nil t))))
 710     (if (= (length key) 1)
 711         ;; Make sure self-insert-command finds the proper character;
 712         ;; unread the character and let the command loop process it.
 713         (setq unread-command-char (string-to-char key))
 714       ;; We can't push back a longer string, so we'll emulate the
 715       ;; command loop ourselves.
 716       (command-execute (key-binding key)))))
 717
 718 (defun describe-arg (value sign)
 719   (cond ((numberp value)
 720          (message "Arg: %d" (* value sign)))
 721         ((consp value)
 722          (message "Arg: [%d]" (car value)))
 723         ((< sign 0)
 724          (message "Arg: -"))))
 725
 726 (defun digit-argument (arg)
 727   "Part of the numeric argument for the next command.
 728 \\[universal-argument] following digits or minus sign ends the argument."
 729   (interactive "P")
 730   (prefix-arg-internal (char-to-string (logand last-command-char ?\177))
 731                        nil arg))
 732
 733 (defun negative-argument (arg)
 734   "Begin a negative numeric argument for the next command.
 735 \\[universal-argument] following digits or minus sign ends the argument."
 736   (interactive "P")
 737   (prefix-arg-internal "-" nil arg))
 738 \f
 739 (defun forward-to-indentation (arg)
 740   "Move forward ARG lines and position at first nonblank character."
 741   (interactive "p")
 742   (forward-line arg)
 743   (skip-chars-forward " \t"))
 744
 745 (defun backward-to-indentation (arg)
 746   "Move backward ARG lines and position at first nonblank character."
 747   (interactive "p")
 748   (forward-line (- arg))
 749   (skip-chars-forward " \t"))
 750
 751 (defun kill-line (&optional arg)
 752   "Kill the rest of the current line; if no nonblanks there, kill thru newline.
 753 With prefix argument, kill that many lines from point.
 754 Negative arguments kill lines backward.
 755
 756 When calling from a program, nil means \"no arg\",
 757 a number counts as a prefix arg."
 758   (interactive "P")
 759   (kill-region (point)
 760                (progn
 761                  (if arg
 762                      (forward-line (prefix-numeric-value arg))
 763                    (if (eobp)
 764                        (signal 'end-of-buffer nil))
 765                    (if (looking-at "[ \t]*$")
 766                        (forward-line 1)
 767                      (end-of-line)))
 768                  (point))))
 769 \f
 770 ;;;; Window system cut and paste hooks.
 771
 772 (defvar interprogram-cut-function nil
 773   "Function to call to make a killed region available to other programs.
 774
 775 Most window systems provide some sort of facility for cutting and
 776 pasting text between the windows of different programs.  On startup,
 777 this variable is set to a function which emacs will call whenever text
 778 is put in the kill ring to make the new kill available to other
 779 programs.
 780
 781 The function takes one argument, TEXT, which is a string containing
 782 the text which should be made available.")
 783
 784 (defvar interprogram-paste-function nil
 785   "Function to call to get text cut from other programs.
 786
 787 Most window systems provide some sort of facility for cutting and
 788 pasting text between the windows of different programs.  On startup,
 789 this variable is set to a function which emacs will call to obtain
 790 text that other programs have provided for pasting.
 791
 792 The function should be called with no arguments.  If the function
 793 returns nil, then no other program has provided such text, and the top
 794 of the Emacs kill ring should be used.  If the function returns a
 795 string, that string should be put in the kill ring as the latest kill.
 796
 797 Note that the function should return a string only if a program other
 798 than Emacs has provided a string for pasting; if Emacs provided the
 799 most recent string, the function should return nil.  If it is
 800 difficult to tell whether Emacs or some other program provided the
 801 current string, it is probably good enough to return nil if the string
 802 is equal (according to `string=') to the last text Emacs provided.")
 803
 804
 805 \f
 806 ;;;; The kill ring data structure.
 807
 808 (defvar kill-ring nil
 809   "List of killed text sequences.
 810 Since the kill ring is supposed to interact nicely with cut-and-paste
 811 facilities offered by window systems, use of this variable should
 812 interact nicely with `interprogram-cut-function' and
 813 `interprogram-paste-function'.  The functions `kill-new',
 814 `kill-append', and `current-kill' are supposed to implement this
 815 interaction; you may want to use them instead of manipulating the kill
 816 ring directly.")
 817
 818 (defconst kill-ring-max 30
 819   "*Maximum length of kill ring before oldest elements are thrown away.")
 820
 821 (defvar kill-ring-yank-pointer nil
 822   "The tail of the kill ring whose car is the last thing yanked.")
 823
 824 (defun kill-new (string)
 825   "Make STRING the latest kill in the kill ring.
 826 Set the kill-ring-yank pointer to point to it.
 827 If `interprogram-cut-function' is non-nil, apply it to STRING."
 828   (setq kill-ring (cons string kill-ring))
 829   (if (> (length kill-ring) kill-ring-max)
 830       (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
 831   (setq kill-ring-yank-pointer kill-ring)
 832   (if interprogram-cut-function
 833       (funcall interprogram-cut-function string)))
 834
 835 (defun kill-append (string before-p)
 836   "Append STRING to the end of the latest kill in the kill ring.
 837 If BEFORE-P is non-nil, prepend STRING to the kill.
 838 If 'interprogram-cut-function' is set, pass the resulting kill to
 839 it."
 840   (setcar kill-ring
 841           (if before-p
 842               (concat string (car kill-ring))
 843             (concat (car kill-ring) string)))
 844   (if interprogram-cut-function
 845       (funcall interprogram-cut-function (car kill-ring))))
 846
 847 (defun current-kill (n &optional do-not-move)
 848   "Rotate the yanking point by N places, and then return that kill.
 849 If N is zero, `interprogram-paste-function' is set, and calling it
 850 returns a string, then that string is added to the front of the
 851 kill ring and returned as the latest kill.
 852 If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
 853 yanking point; just return the Nth kill forward."
 854   (let ((interprogram-paste (and (= n 0)
 855                                  interprogram-paste-function
 856                                  (funcall interprogram-paste-function))))
 857     (if interprogram-paste
 858         (progn
 859           ;; Disable the interprogram cut function when we add the new
 860           ;; text to the kill ring, so Emacs doesn't try to own the
 861           ;; selection, with identical text.
 862           (let ((interprogram-cut-function nil))
 863             (kill-new interprogram-paste))
 864           interprogram-paste)
 865       (or kill-ring (error "Kill ring is empty"))
 866       (let* ((length (length kill-ring))
 867              (ARGth-kill-element
 868               (nthcdr (% (+ n (- length (length kill-ring-yank-pointer)))
 869                          length)
 870                       kill-ring)))
 871         (or do-not-move
 872             (setq kill-ring-yank-pointer ARGth-kill-element))
 873         (car ARGth-kill-element)))))
 874
 875
 876 \f
 877 ;;;; Commands for manipulating the kill ring.
 878
 879 (defun kill-region (beg end)
 880   "Kill between point and mark.
 881 The text is deleted but saved in the kill ring.
 882 The command \\[yank] can retrieve it from there.
 883 \(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
 884
 885 This is the primitive for programs to kill text (as opposed to deleting it).
 886 Supply two arguments, character numbers indicating the stretch of text
 887  to be killed.
 888 Any command that calls this function is a \"kill command\".
 889 If the previous command was also a kill command,
 890 the text killed this time appends to the text killed last time
 891 to make one entry in the kill ring."
 892   (interactive "r")
 893   (cond
 894    (buffer-read-only
 895     (copy-region-as-kill beg end))
 896    ((not (or (eq buffer-undo-list t)
 897              (eq last-command 'kill-region)
 898              (eq beg end)))
 899     ;; Don't let the undo list be truncated before we can even access it.
 900     (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100)))
 901       (delete-region beg end)
 902       ;; Take the same string recorded for undo
 903       ;; and put it in the kill-ring.
 904       (kill-new (car (car buffer-undo-list)))
 905       (setq this-command 'kill-region)))
 906    (t
 907     (copy-region-as-kill beg end)
 908     (delete-region beg end))))
 909
 910 (defun copy-region-as-kill (beg end)
 911   "Save the region as if killed, but don't kill it.
 912 If `interprogram-cut-function' is non-nil, also save the text for a window
 913 system cut and paste."
 914   (interactive "r")
 915   (if (eq last-command 'kill-region)
 916       (kill-append (buffer-substring beg end) (< end beg))
 917     (kill-new (buffer-substring beg end)))
 918   (setq this-command 'kill-region)
 919   nil)
 920
 921 (defun kill-ring-save (beg end)
 922   "Save the region as if killed, but don't kill it."
 923   (interactive "r")
 924   (copy-region-as-kill beg end)
 925   (if (interactive-p)
 926       (save-excursion
 927         (let ((other-end (if (= (point) beg) end beg)))
 928           (if (pos-visible-in-window-p other-end (selected-window))
 929               (progn
 930                 (goto-char other-end)
 931                 (sit-for 1))
 932             (let* ((killed-text (current-kill 0))
 933                    (message-len (min (length killed-text) 40)))
 934               (if (= (point) beg)
 935                   ;; Don't say "killed"; that is misleading.
 936                   (message "Saved text until \"%s\""
 937                           (substring killed-text (- message-len)))
 938                 (message "Saved text from \"%s\""
 939                         (substring killed-text 0 message-len)))))))))
 940
 941 (defun append-next-kill ()
 942   "Cause following command, if kill, to append to previous kill."
 943   (interactive)
 944   (if (interactive-p)
 945       (progn
 946         (setq this-command 'kill-region)
 947         (message "If the next command is a kill, it will append"))
 948     (setq last-command 'kill-region)))
 949
 950 (defun yank-pop (arg)
 951   "Replace just-yanked stretch of killed-text with a different stretch.
 952 This command is allowed only immediately after a  yank  or a  yank-pop.
 953 At such a time, the region contains a stretch of reinserted
 954 previously-killed text.  yank-pop  deletes that text and inserts in its
 955 place a different stretch of killed text.
 956
 957 With no argument, the previous kill is inserted.
 958 With argument n, the n'th previous kill is inserted.
 959 If n is negative, this is a more recent kill.
 960
 961 The sequence of kills wraps around, so that after the oldest one
 962 comes the newest one."
 963   (interactive "*p")
 964   (if (not (eq last-command 'yank))
 965       (error "Previous command was not a yank"))
 966   (setq this-command 'yank)
 967   (let ((before (< (point) (mark))))
 968     (delete-region (point) (mark))
 969     (set-mark (point))
 970     (insert (current-kill arg))
 971     (if before (exchange-point-and-mark))))
 972
 973 (defun yank (&optional arg)
 974   "Reinsert the last stretch of killed text.
 975 More precisely, reinsert the stretch of killed text most recently
 976 killed OR yanked.
 977 With just C-U as argument, same but put point in front (and mark at end).
 978 With argument n, reinsert the nth most recently killed stretch of killed
 979 text.
 980 See also the command \\[yank-pop]."
 981   (interactive "*P")
 982   (push-mark (point))
 983   (insert (current-kill (cond
 984                          ((listp arg) 0)
 985                          ((eq arg '-) -1)
 986                          (t (1- arg)))))
 987   (if (consp arg)
 988       (exchange-point-and-mark)))
 989
 990 (defun rotate-yank-pointer (arg)
 991   "Rotate the yanking point in the kill ring.
 992 With argument, rotate that many kills forward (or backward, if negative)."
 993   (interactive "p")
 994   (current-kill arg))
 995
 996 \f
 997 (defun insert-buffer (buffer)
 998   "Insert after point the contents of BUFFER.
 999 Puts mark after the inserted text.
1000 BUFFER may be a buffer or a buffer name."
1001   (interactive (list (read-buffer "Insert buffer: " (other-buffer) t)))
1002   (or (bufferp buffer)
1003       (setq buffer (get-buffer buffer)))
1004   (let (start end newmark)
1005     (save-excursion
1006       (save-excursion
1007         (set-buffer buffer)
1008         (setq start (point-min) end (point-max)))
1009       (insert-buffer-substring buffer start end)
1010       (setq newmark (point)))
1011     (push-mark newmark)))
1012
1013 (defun append-to-buffer (buffer start end)
1014   "Append to specified buffer the text of the region.
1015 It is inserted into that buffer before its point.
1016
1017 When calling from a program, give three arguments:
1018 BUFFER (or buffer name), START and END.
1019 START and END specify the portion of the current buffer to be copied."
1020   (interactive
1021    (list (read-buffer "Append to buffer: " (other-buffer nil t) t)))
1022   (let ((oldbuf (current-buffer)))
1023     (save-excursion
1024       (set-buffer (get-buffer-create buffer))
1025       (insert-buffer-substring oldbuf start end))))
1026
1027 (defun prepend-to-buffer (buffer start end)
1028   "Prepend to specified buffer the text of the region.
1029 It is inserted into that buffer after its point.
1030
1031 When calling from a program, give three arguments:
1032 BUFFER (or buffer name), START and END.
1033 START and END specify the portion of the current buffer to be copied."
1034   (interactive "BPrepend to buffer: \nr")
1035   (let ((oldbuf (current-buffer)))
1036     (save-excursion
1037       (set-buffer (get-buffer-create buffer))
1038       (save-excursion
1039         (insert-buffer-substring oldbuf start end)))))
1040
1041 (defun copy-to-buffer (buffer start end)
1042   "Copy to specified buffer the text of the region.
1043 It is inserted into that buffer, replacing existing text there.
1044
1045 When calling from a program, give three arguments:
1046 BUFFER (or buffer name), START and END.
1047 START and END specify the portion of the current buffer to be copied."
1048   (interactive "BCopy to buffer: \nr")
1049   (let ((oldbuf (current-buffer)))
1050     (save-excursion
1051       (set-buffer (get-buffer-create buffer))
1052       (erase-buffer)
1053       (save-excursion
1054         (insert-buffer-substring oldbuf start end)))))
1055 \f
1056 (defun mark ()
1057   "Return this buffer's mark value as integer, or nil if no mark.
1058 If you are using this in an editing command, you are most likely making
1059 a mistake; see the documentation of `set-mark'."
1060   (marker-position (mark-marker)))
1061
1062 (defun set-mark (pos)
1063   "Set this buffer's mark to POS.  Don't use this function!
1064 That is to say, don't use this function unless you want
1065 the user to see that the mark has moved, and you want the previous
1066 mark position to be lost.
1067
1068 Normally, when a new mark is set, the old one should go on the stack.
1069 This is why most applications should use push-mark, not set-mark.
1070
1071 Novice emacs-lisp programmers often try to use the mark for the wrong
1072 purposes.  The mark saves a location for the user's convenience.
1073 Most editing commands should not alter the mark.
1074 To remember a location for internal use in the Lisp program,
1075 store it in a Lisp variable.  Example:
1076
1077    (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
1078
1079   (set-marker (mark-marker) pos (current-buffer)))
1080
1081 (defvar mark-ring nil
1082   "The list of saved former marks of the current buffer,
1083 most recent first.")
1084 (make-variable-buffer-local 'mark-ring)
1085
1086 (defconst mark-ring-max 16
1087   "*Maximum size of mark ring.  Start discarding off end if gets this big.")
1088
1089 (defun set-mark-command (arg)
1090   "Set mark at where point is, or jump to mark.
1091 With no prefix argument, set mark, and push previous mark on mark ring.
1092 With argument, jump to mark, and pop into mark off the mark ring.
1093
1094 Novice emacs-lisp programmers often try to use the mark for the wrong
1095 purposes.  See the documentation of `set-mark' for more information."
1096   (interactive "P")
1097   (if (null arg)
1098       (push-mark)
1099     (if (null (mark))
1100         (error "No mark set in this buffer")
1101       (goto-char (mark))
1102       (pop-mark))))
1103
1104 (defun push-mark (&optional location nomsg)
1105   "Set mark at LOCATION (point, by default) and push old mark on mark ring.
1106 Displays \"Mark set\" unless the optional second arg NOMSG is non-nil.
1107
1108 Novice emacs-lisp programmers often try to use the mark for the wrong
1109 purposes.  See the documentation of `set-mark' for more information."
1110   (if (null (mark))
1111       nil
1112     (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
1113     (if (> (length mark-ring) mark-ring-max)
1114         (progn
1115           (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
1116           (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
1117   (set-mark (or location (point)))
1118   (or nomsg executing-macro (> (minibuffer-depth) 0)
1119       (message "Mark set"))
1120   nil)
1121
1122 (defun pop-mark ()
1123   "Pop off mark ring into the buffer's actual mark.
1124 Does not set point.  Does nothing if mark ring is empty."
1125   (if mark-ring
1126       (progn
1127         (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
1128         (set-mark (+ 0 (car mark-ring)))
1129         (move-marker (car mark-ring) nil)
1130         (if (null (mark)) (ding))
1131         (setq mark-ring (cdr mark-ring)))))
1132
1133 (fset 'exchange-dot-and-mark 'exchange-point-and-mark)
1134 (defun exchange-point-and-mark ()
1135   "Put the mark where point is now, and point where the mark is now."
1136   (interactive nil)
1137   (let ((omark (mark)))
1138     (if (null omark)
1139         (error "No mark set in this buffer"))
1140     (set-mark (point))
1141     (goto-char omark)
1142     nil))
1143 \f
1144 (defun next-line (arg)
1145   "Move cursor vertically down ARG lines.
1146 If there is no character in the target line exactly under the current column,
1147 the cursor is positioned after the character in that line which spans this
1148 column, or at the end of the line if it is not long enough.
1149 If there is no line in the buffer after this one,
1150 a newline character is inserted to create a line
1151 and the cursor moves to that line.
1152
1153 The command \\[set-goal-column] can be used to create
1154 a semipermanent goal column to which this command always moves.
1155 Then it does not try to move vertically.  This goal column is stored
1156 in `goal-column', which is nil when there is none.
1157
1158 If you are thinking of using this in a Lisp program, consider
1159 using `forward-line' instead.  It is usually easier to use
1160 and more reliable (no dependence on goal column, etc.)."
1161   (interactive "p")
1162   (if (= arg 1)
1163       (let ((opoint (point)))
1164         (forward-line 1)
1165         (if (or (= opoint (point))
1166                 (not (eq (preceding-char) ?\n)))
1167             (insert ?\n)
1168           (goto-char opoint)
1169           (line-move arg)))
1170     (line-move arg))
1171   nil)
1172
1173 (defun previous-line (arg)
1174   "Move cursor vertically up ARG lines.
1175 If there is no character in the target line exactly over the current column,
1176 the cursor is positioned after the character in that line which spans this
1177 column, or at the end of the line if it is not long enough.
1178
1179 The command \\[set-goal-column] can be used to create
1180 a semipermanent goal column to which this command always moves.
1181 Then it does not try to move vertically.
1182
1183 If you are thinking of using this in a Lisp program, consider using
1184 `forward-line' with negative argument instead..  It is usually easier
1185 to use and more reliable (no dependence on goal column, etc.)."
1186   (interactive "p")
1187   (line-move (- arg))
1188   nil)
1189
1190 (defconst track-eol nil
1191   "*Non-nil means vertical motion starting at end of line keeps to ends of lines.
1192 This means moving to the end of each line moved onto.
1193 The beginning of a blank line does not count as the end of a line.")
1194
1195 (make-variable-buffer-local
1196  (defvar goal-column nil
1197    "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil."))
1198
1199 (defvar temporary-goal-column 0
1200   "Current goal column for vertical motion.
1201 It is the column where point was
1202 at the start of current run of vertical motion commands.
1203 When the `track-eol' feature is doing its job, the value is 9999.")
1204
1205 (defun line-move (arg)
1206   (if (not (or (eq last-command 'next-line)
1207                (eq last-command 'previous-line)))
1208       (setq temporary-goal-column
1209             (if (and track-eol (eolp)
1210                      ;; Don't count beg of empty line as end of line
1211                      ;; unless we just did explicit end-of-line.
1212                      (or (not (bolp)) (eq last-command 'end-of-line)))
1213                 9999
1214               (current-column))))
1215   (if (not (integerp selective-display))
1216       (forward-line arg)
1217     ;; Move by arg lines, but ignore invisible ones.
1218     (while (> arg 0)
1219       (vertical-motion 1)
1220       (forward-char -1)
1221       (forward-line 1)
1222       (setq arg (1- arg)))
1223     (while (< arg 0)
1224       (vertical-motion -1)
1225       (beginning-of-line)
1226       (setq arg (1+ arg))))
1227   (move-to-column (or goal-column temporary-goal-column))
1228   nil)
1229
1230
1231 (defun set-goal-column (arg)
1232   "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
1233 Those commands will move to this position in the line moved to
1234 rather than trying to keep the same horizontal position.
1235 With a non-nil argument, clears out the goal column
1236 so that \\[next-line] and \\[previous-line] resume vertical motion."
1237   (interactive "P")
1238   (if arg
1239       (progn
1240         (setq goal-column nil)
1241         (message "No goal column"))
1242     (setq goal-column (current-column))
1243     (message (substitute-command-keys
1244               "Goal column %d (use \\[set-goal-column] with an arg to unset it)")
1245              goal-column))
1246   nil)
1247 \f
1248 (defun transpose-chars (arg)
1249   "Interchange characters around point, moving forward one character.
1250 With prefix arg ARG, effect is to take character before point
1251 and drag it forward past ARG other characters (backward if ARG negative).
1252 If no argument and at end of line, the previous two chars are exchanged."
1253   (interactive "*P")
1254   (and (null arg) (eolp) (forward-char -1))
1255   (transpose-subr 'forward-char (prefix-numeric-value arg)))
1256
1257 (defun transpose-words (arg)
1258   "Interchange words around point, leaving point at end of them.
1259 With prefix arg ARG, effect is to take word before or around point
1260 and drag it forward past ARG other words (backward if ARG negative).
1261 If ARG is zero, the words around or after point and around or after mark
1262 are interchanged."
1263   (interactive "*p")
1264   (transpose-subr 'forward-word arg))
1265
1266 (defun transpose-sexps (arg)
1267   "Like \\[transpose-words] but applies to sexps.
1268 Does not work on a sexp that point is in the middle of
1269 if it is a list or string."
1270   (interactive "*p")
1271   (transpose-subr 'forward-sexp arg))
1272
1273 (defun transpose-lines (arg)
1274   "Exchange current line and previous line, leaving point after both.
1275 With argument ARG, takes previous line and moves it past ARG lines.
1276 With argument 0, interchanges line point is in with line mark is in."
1277   (interactive "*p")
1278   (transpose-subr (function
1279                    (lambda (arg)
1280                      (if (= arg 1)
1281                          (progn
1282                            ;; Move forward over a line,
1283                            ;; but create a newline if none exists yet.
1284                            (end-of-line)
1285                            (if (eobp)
1286                                (newline)
1287                              (forward-char 1)))
1288                        (forward-line arg))))
1289                   arg))
1290
1291 (defun transpose-subr (mover arg)
1292   (let (start1 end1 start2 end2)
1293     (if (= arg 0)
1294         (progn
1295           (save-excursion
1296             (funcall mover 1)
1297             (setq end2 (point))
1298             (funcall mover -1)
1299             (setq start2 (point))
1300             (goto-char (mark))
1301             (funcall mover 1)
1302             (setq end1 (point))
1303             (funcall mover -1)
1304             (setq start1 (point))
1305             (transpose-subr-1))
1306           (exchange-point-and-mark)))
1307     (while (> arg 0)
1308       (funcall mover -1)
1309       (setq start1 (point))
1310       (funcall mover 1)
1311       (setq end1 (point))
1312       (funcall mover 1)
1313       (setq end2 (point))
1314       (funcall mover -1)
1315       (setq start2 (point))
1316       (transpose-subr-1)
1317       (goto-char end2)
1318       (setq arg (1- arg)))
1319     (while (< arg 0)
1320       (funcall mover -1)
1321       (setq start2 (point))
1322       (funcall mover -1)
1323       (setq start1 (point))
1324       (funcall mover 1)
1325       (setq end1 (point))
1326       (funcall mover 1)
1327       (setq end2 (point))
1328       (transpose-subr-1)
1329       (setq arg (1+ arg)))))
1330
1331 (defun transpose-subr-1 ()
1332   (if (> (min end1 end2) (max start1 start2))
1333       (error "Don't have two things to transpose"))
1334   (let ((word1 (buffer-substring start1 end1))
1335         (word2 (buffer-substring start2 end2)))
1336     (delete-region start2 end2)
1337     (goto-char start2)
1338     (insert word1)
1339     (goto-char (if (< start1 start2) start1
1340                  (+ start1 (- (length word1) (length word2)))))
1341     (delete-char (length word1))
1342     (insert word2)))
1343 \f
1344 (defconst comment-column 32
1345   "*Column to indent right-margin comments to.
1346 Setting this variable automatically makes it local to the current buffer.")
1347 (make-variable-buffer-local 'comment-column)
1348
1349 (defconst comment-start nil
1350   "*String to insert to start a new comment, or nil if no comment syntax defined.")
1351
1352 (defconst comment-start-skip nil
1353   "*Regexp to match the start of a comment plus everything up to its body.
1354 If there are any \\(...\\) pairs, the comment delimiter text is held to begin
1355 at the place matched by the close of the first pair.")
1356
1357 (defconst comment-end ""
1358   "*String to insert to end a new comment.
1359 Should be an empty string if comments are terminated by end-of-line.")
1360
1361 (defconst comment-indent-hook
1362   '(lambda () comment-column)
1363   "Function to compute desired indentation for a comment.
1364 This function is called with no args with point at the beginning of
1365 the comment's starting delimiter.")
1366
1367 (defun indent-for-comment ()
1368   "Indent this line's comment to comment column, or insert an empty comment."
1369   (interactive "*")
1370   (beginning-of-line 1)
1371   (if (null comment-start)
1372       (error "No comment syntax defined")
1373     (let* ((eolpos (save-excursion (end-of-line) (point)))
1374            cpos indent begpos)
1375       (if (re-search-forward comment-start-skip eolpos 'move)
1376           (progn (setq cpos (point-marker))
1377                  ;; Find the start of the comment delimiter.
1378                  ;; If there were paren-pairs in comment-start-skip,
1379                  ;; position at the end of the first pair.
1380                  (if (match-end 1)
1381                      (goto-char (match-end 1))
1382                    ;; If comment-start-skip matched a string with internal
1383                    ;; whitespace (not final whitespace) then the delimiter
1384                    ;; start at the end of that whitespace.
1385                    ;; Otherwise, it starts at the beginning of what was matched.
1386                    (skip-chars-backward " \t" (match-beginning 0))
1387                    (skip-chars-backward "^ \t" (match-beginning 0)))))
1388       (setq begpos (point))
1389       ;; Compute desired indent.
1390       (if (= (current-column)
1391              (setq indent (funcall comment-indent-hook)))
1392           (goto-char begpos)
1393         ;; If that's different from current, change it.
1394         (skip-chars-backward " \t")
1395         (delete-region (point) begpos)
1396         (indent-to indent))
1397       ;; An existing comment?
1398       (if cpos
1399           (progn (goto-char cpos)
1400                  (set-marker cpos nil))
1401         ;; No, insert one.
1402         (insert comment-start)
1403         (save-excursion
1404           (insert comment-end))))))
1405
1406 (defun set-comment-column (arg)
1407   "Set the comment column based on point.
1408 With no arg, set the comment column to the current column.
1409 With just minus as arg, kill any comment on this line.
1410 With any other arg, set comment column to indentation of the previous comment
1411  and then align or create a comment on this line at that column."
1412   (interactive "P")
1413   (if (eq arg '-)
1414       (kill-comment nil)
1415     (if arg
1416         (progn
1417           (save-excursion
1418             (beginning-of-line)
1419             (re-search-backward comment-start-skip)
1420             (beginning-of-line)
1421             (re-search-forward comment-start-skip)
1422             (goto-char (match-beginning 0))
1423             (setq comment-column (current-column))
1424             (message "Comment column set to %d" comment-column))
1425           (indent-for-comment))
1426       (setq comment-column (current-column))
1427       (message "Comment column set to %d" comment-column))))
1428
1429 (defun kill-comment (arg)
1430   "Kill the comment on this line, if any.
1431 With argument, kill comments on that many lines starting with this one."
1432   ;; this function loses in a lot of situations.  it incorrectly recognises
1433   ;; comment delimiters sometimes (ergo, inside a string), doesn't work
1434   ;; with multi-line comments, can kill extra whitespace if comment wasn't
1435   ;; through end-of-line, et cetera.
1436   (interactive "P")
1437   (or comment-start-skip (error "No comment syntax defined"))
1438   (let ((count (prefix-numeric-value arg)) endc)
1439     (while (> count 0)
1440       (save-excursion
1441         (end-of-line)
1442         (setq endc (point))
1443         (beginning-of-line)
1444         (and (string< "" comment-end)
1445              (setq endc
1446                    (progn
1447                      (re-search-forward (regexp-quote comment-end) endc 'move)
1448                      (skip-chars-forward " \t")
1449                      (point))))
1450         (beginning-of-line)
1451         (if (re-search-forward comment-start-skip endc t)
1452             (progn
1453               (goto-char (match-beginning 0))
1454               (skip-chars-backward " \t")
1455               (kill-region (point) endc)
1456               ;; to catch comments a line beginnings
1457               (indent-according-to-mode))))
1458       (if arg (forward-line 1))
1459       (setq count (1- count)))))
1460
1461 (defun comment-region (beg end &optional arg)
1462   "Comment the region; third arg numeric means use ARG comment characters.
1463 If ARG is negative, delete that many comment characters instead.
1464 Comments are terminated on each line, even for syntax in which newline does
1465 not end the comment.  Blank lines do not get comments."
1466   ;; if someone wants it to only put a comment-start at the beginning and
1467   ;; comment-end at the end then typing it, C-x C-x, closing it, C-x C-x
1468   ;; is easy enough.  No option is made here for other than commenting
1469   ;; every line.
1470   (interactive "r\np")
1471   (or comment-start (error "No comment syntax is defined"))
1472   (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
1473   (save-excursion
1474     (save-restriction
1475       (let ((cs comment-start) (ce comment-end))
1476         (cond ((not arg) (setq arg 1))
1477               ((> arg 1)
1478                (while (> (setq arg (1- arg)) 0)
1479                  (setq cs (concat cs comment-start)
1480                        ce (concat ce comment-end)))))
1481         (narrow-to-region beg end)
1482         (goto-char beg)
1483         (while (not (eobp))
1484           (if (< arg 0)
1485               (let ((count arg))
1486                 (while (and (> 1 (setq count (1+ count)))
1487                             (looking-at (regexp-quote cs)))
1488                   (delete-char (length cs)))
1489                 (if (string= "" ce) ()
1490                   (setq count arg)
1491                   (while (> 1 (setq count (1+ count)))
1492                     (end-of-line)
1493                     ;; this is questionable if comment-end ends in whitespace
1494                     ;; that is pretty brain-damaged though
1495                     (skip-chars-backward " \t")
1496                     (backward-char (length ce))
1497                     (if (looking-at (regexp-quote ce))
1498                         (delete-char (length ce))))))
1499             (if (looking-at "[ \t]*$") ()
1500               (insert cs)
1501               (if (string= "" ce) ()
1502                 (end-of-line)
1503                 (insert ce)))
1504             (search-forward "\n" nil 'move)))))))
1505 \f
1506 (defun backward-word (arg)
1507   "Move backward until encountering the end of a word.
1508 With argument, do this that many times.
1509 In programs, it is faster to call forward-word with negative arg."
1510   (interactive "p")
1511   (forward-word (- arg)))
1512
1513 (defun mark-word (arg)
1514   "Set mark arg words away from point."
1515   (interactive "p")
1516   (push-mark
1517     (save-excursion
1518       (forward-word arg)
1519       (point))))
1520
1521 (defun kill-word (arg)
1522   "Kill characters forward until encountering the end of a word.
1523 With argument, do this that many times."
1524   (interactive "p")
1525   (kill-region (point) (progn (forward-word arg) (point))))
1526
1527 (defun backward-kill-word (arg)
1528   "Kill characters backward until encountering the end of a word.
1529 With argument, do this that many times."
1530   (interactive "p")
1531   (kill-word (- arg)))
1532 \f
1533 (defconst fill-prefix nil
1534   "*String for filling to insert at front of new line, or nil for none.
1535 Setting this variable automatically makes it local to the current buffer.")
1536 (make-variable-buffer-local 'fill-prefix)
1537
1538 (defconst auto-fill-inhibit-regexp nil
1539   "*Regexp to match lines which should not be auto-filled.")
1540
1541 (defun do-auto-fill ()
1542   (let (give-up)
1543     (or (and auto-fill-inhibit-regexp
1544              (save-excursion (beginning-of-line)
1545                              (looking-at auto-fill-inhibit-regexp)))
1546         (while (and (not give-up) (> (current-column) fill-column))
1547           (let ((fill-point
1548                  (let ((opoint (point)))
1549                    (save-excursion
1550                      (move-to-column (1+ fill-column))
1551                      (skip-chars-backward "^ \t\n")
1552                      (if (bolp)
1553                          (re-search-forward "[ \t]" opoint t))
1554                      (skip-chars-backward " \t")
1555                      (point)))))
1556             ;; If there is a space on the line before fill-point,
1557             ;; and nonspaces precede it, break the line there.
1558             (if (save-excursion
1559                   (goto-char fill-point)
1560                   (not (bolp)))
1561                 ;; If point is at the fill-point, do not `save-excursion'.
1562                 ;; Otherwise, if a comment prefix or fill-prefix is inserted,
1563                 ;; point will end up before it rather than after it.
1564                 (if (save-excursion
1565                       (skip-chars-backward " \t")
1566                       (= (point) fill-point))
1567                     (indent-new-comment-line)
1568                   (save-excursion
1569                     (goto-char fill-point)
1570                     (indent-new-comment-line)))
1571               ;; No place to break => stop trying.
1572               (setq give-up t)))))))
1573
1574 (defconst comment-multi-line nil
1575   "*Non-nil means \\[indent-new-comment-line] should continue same comment
1576 on new line, with no new terminator or starter.
1577 This is obsolete because you might as well use \\[newline-and-indent].")
1578
1579 (defun indent-new-comment-line ()
1580   "Break line at point and indent, continuing comment if presently within one.
1581 The body of the continued comment is indented under the previous comment line.
1582
1583 This command is intended for styles where you write a comment per line,
1584 starting a new comment (and terminating it if necessary) on each line.
1585 If you want to continue one comment across several lines, use \\[newline-and-indent]."
1586   (interactive "*")
1587   (let (comcol comstart)
1588     (skip-chars-backward " \t")
1589     (delete-region (point)
1590                    (progn (skip-chars-forward " \t")
1591                           (point)))
1592     (insert ?\n)
1593     (if (not comment-multi-line)
1594         (save-excursion
1595           (if (and comment-start-skip
1596                    (let ((opoint (point)))
1597                      (forward-line -1)
1598                      (re-search-forward comment-start-skip opoint t)))
1599               ;; The old line is a comment.
1600               ;; Set WIN to the pos of the comment-start.
1601               ;; But if the comment is empty, look at preceding lines
1602               ;; to find one that has a nonempty comment.
1603               (let ((win (match-beginning 0)))
1604                 (while (and (eolp) (not (bobp))
1605                             (let (opoint)
1606                               (beginning-of-line)
1607                               (setq opoint (point))
1608                               (forward-line -1)
1609                               (re-search-forward comment-start-skip opoint t)))
1610                   (setq win (match-beginning 0)))
1611                 ;; Indent this line like what we found.
1612                 (goto-char win)
1613                 (setq comcol (current-column))
1614                 (setq comstart (buffer-substring (point) (match-end 0)))))))
1615     (if comcol
1616         (let ((comment-column comcol)
1617               (comment-start comstart)
1618               (comment-end comment-end))
1619           (and comment-end (not (equal comment-end ""))
1620 ;              (if (not comment-multi-line)
1621                    (progn
1622                      (forward-char -1)
1623                      (insert comment-end)
1624                      (forward-char 1))
1625 ;                (setq comment-column (+ comment-column (length comment-start))
1626 ;                      comment-start "")
1627 ;                  )
1628                )
1629           (if (not (eolp))
1630               (setq comment-end ""))
1631           (insert ?\n)
1632           (forward-char -1)
1633           (indent-for-comment)
1634           (save-excursion
1635             ;; Make sure we delete the newline inserted above.
1636             (end-of-line)
1637             (delete-char 1)))
1638       (if fill-prefix
1639           (insert fill-prefix)
1640         (indent-according-to-mode)))))
1641
1642 (defun auto-fill-mode (&optional arg)
1643   "Toggle auto-fill mode.
1644 With arg, turn auto-fill mode on if and only if arg is positive.
1645 In auto-fill mode, inserting a space at a column beyond  fill-column
1646 automatically breaks the line at a previous space."
1647   (interactive "P")
1648   (prog1 (setq auto-fill-function
1649                (if (if (null arg)
1650                        (not auto-fill-function)
1651                        (> (prefix-numeric-value arg) 0))
1652                    'do-auto-fill
1653                    nil))
1654     ;; update mode-line
1655     (set-buffer-modified-p (buffer-modified-p))))
1656
1657 (defun turn-on-auto-fill ()
1658   "Unconditionally turn on Auto Fill mode."
1659   (auto-fill-mode 1))
1660
1661 (defun set-fill-column (arg)
1662   "Set fill-column to current column, or to argument if given.
1663 fill-column's value is separate for each buffer."
1664   (interactive "P")
1665   (setq fill-column (if (integerp arg) arg (current-column)))
1666   (message "fill-column set to %d" fill-column))
1667 \f
1668 (defun set-selective-display (arg)
1669   "Set selective-display to ARG; clear it if no arg.
1670 When selective-display is a number > 0,
1671 lines whose indentation is >= selective-display are not displayed.
1672 selective-display's value is separate for each buffer."
1673   (interactive "P")
1674   (if (eq selective-display t)
1675       (error "selective-display already in use for marked lines"))
1676   (let ((current-vpos
1677          (save-restriction
1678            (narrow-to-region (point-min) (point))
1679            (goto-char (window-start))
1680            (vertical-motion (window-height)))))
1681     (setq selective-display
1682           (and arg (prefix-numeric-value arg)))
1683     (recenter current-vpos))
1684   (set-window-start (selected-window) (window-start (selected-window)))
1685   (princ "selective-display set to " t)
1686   (prin1 selective-display t)
1687   (princ "." t))
1688
1689 (defun overwrite-mode (arg)
1690   "Toggle overwrite mode.
1691 With arg, turn overwrite mode on iff arg is positive.
1692 In overwrite mode, printing characters typed in replace existing text
1693 on a one-for-one basis, rather than pushing it to the right."
1694   (interactive "P")
1695   (setq overwrite-mode
1696         (if (null arg) (not overwrite-mode)
1697           (> (prefix-numeric-value arg) 0)))
1698   (set-buffer-modified-p (buffer-modified-p))) ;No-op, but updates mode line.
1699 \f
1700 (defvar blink-matching-paren t
1701   "*Non-nil means show matching open-paren when close-paren is inserted.")
1702
1703 (defconst blink-matching-paren-distance 4000
1704   "*If non-nil, is maximum distance to search for matching open-paren
1705 when close-paren is inserted.")
1706
1707 (defun blink-matching-open ()
1708   "Move cursor momentarily to the beginning of the sexp before point."
1709   (interactive)
1710   (and (> (point) (1+ (point-min)))
1711        (/= (char-syntax (char-after (- (point) 2))) ?\\ )
1712        blink-matching-paren
1713        (let* ((oldpos (point))
1714               (blinkpos)
1715               (mismatch))
1716          (save-excursion
1717            (save-restriction
1718              (if blink-matching-paren-distance
1719                  (narrow-to-region (max (point-min)
1720                                         (- (point) blink-matching-paren-distance))
1721                                    oldpos))
1722              (condition-case ()
1723                  (setq blinkpos (scan-sexps oldpos -1))
1724                (error nil)))
1725            (and blinkpos (/= (char-syntax (char-after blinkpos))
1726                              ?\$)
1727                 (setq mismatch
1728                       (/= (char-after (1- oldpos))
1729                           (logand (lsh (aref (syntax-table)
1730                                              (char-after blinkpos))
1731                                        -8)
1732                                   255))))
1733            (if mismatch (setq blinkpos nil))
1734            (if blinkpos
1735                (progn
1736                 (goto-char blinkpos)
1737                 (if (pos-visible-in-window-p)
1738                     (sit-for 1)
1739                   (goto-char blinkpos)
1740                   (message
1741                    "Matches %s"
1742                    (if (save-excursion
1743                          (skip-chars-backward " \t")
1744                          (not (bolp)))
1745                        (buffer-substring (progn (beginning-of-line) (point))
1746                                          (1+ blinkpos))
1747                      (buffer-substring blinkpos
1748                                        (progn
1749                                         (forward-char 1)
1750                                         (skip-chars-forward "\n \t")
1751                                         (end-of-line)
1752                                         (point)))))))
1753              (cond (mismatch
1754                     (message "Mismatched parentheses"))
1755                    ((not blink-matching-paren-distance)
1756                     (message "Unmatched parenthesis"))))))))
1757
1758 ;Turned off because it makes dbx bomb out.
1759 (setq blink-paren-function 'blink-matching-open)
1760
1761 ; this is just something for the luser to see in a keymap -- this is not
1762 ;  how quitting works normally!
1763 (defun keyboard-quit ()
1764   "Signal a  quit  condition."
1765   (interactive)
1766   (signal 'quit nil))
1767
1768 (define-key global-map "\C-g" 'keyboard-quit)
1769 \f
1770 (defun set-variable (var val)
1771   "Set VARIABLE to VALUE.  VALUE is a Lisp object.
1772 When using this interactively, supply a Lisp expression for VALUE.
1773 If you want VALUE to be a string, you must surround it with doublequotes.
1774
1775 If VARIABLE has a `variable-interactive' property, that is used as if
1776 it were the arg to `interactive' (which see) to interactively read the value."
1777   (interactive
1778    (let* ((var (read-variable "Set variable: "))
1779           (minibuffer-help-form
1780            '(funcall myhelp))
1781           (myhelp
1782            (function
1783             (lambda ()
1784               (with-output-to-temp-buffer "*Help*"
1785                 (prin1 var)
1786                 (princ "\nDocumentation:\n")
1787                 (princ (substring (documentation-property var 'variable-documentation)
1788                                   1))
1789                 (if (boundp var)
1790                     (let ((print-length 20))
1791                       (princ "\n\nCurrent value: ")
1792                       (prin1 (symbol-value var))))
1793                 nil)))))
1794      (list var
1795            (let ((prop (get var 'variable-interactive)))
1796              (if prop
1797                  ;; Use VAR's `variable-interactive' property
1798                  ;; as an interactive spec for prompting.
1799                  (call-interactively (list 'lambda '(arg)
1800                                            (list 'interactive prop)
1801                                            'arg))
1802                (eval-minibuffer (format "Set %s to value: " var)))))))
1803   (set var val))
1804
1805 ;;; simple.el ends here