PageRenderTime 84ms CodeModel.GetById 8ms app.highlight 49ms RepoModel.GetById 1ms app.codeStats 2ms

/ntemacs23.1/lisp/simple.el

https://bitbucket.org/fangzhzh/temp
Lisp | 6544 lines | 5181 code | 606 blank | 757 comment | 235 complexity | 6d2a25e1237d3e531aaeefda655f008d MD5 | raw file

Large files files are truncated, but you can click here to view the full file

   1;;; simple.el --- basic editing commands for Emacs
   2
   3;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
   4;;   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
   5;;   Free Software Foundation, Inc.
   6
   7;; Maintainer: FSF
   8;; Keywords: internal
   9
  10;; This file is part of GNU Emacs.
  11
  12;; GNU Emacs is free software: you can redistribute it and/or modify
  13;; it under the terms of the GNU General Public License as published by
  14;; the Free Software Foundation, either version 3 of the License, or
  15;; (at your option) any later version.
  16
  17;; GNU Emacs is distributed in the hope that it will be useful,
  18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20;; GNU General Public License for more details.
  21
  22;; You should have received a copy of the GNU General Public License
  23;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25;;; Commentary:
  26
  27;; A grab-bag of basic Emacs commands not specifically related to some
  28;; major mode or to file-handling.
  29
  30;;; Code:
  31
  32;; This is for lexical-let in apply-partially.
  33(eval-when-compile (require 'cl))
  34
  35(declare-function widget-convert "wid-edit" (type &rest args))
  36(declare-function shell-mode "shell" ())
  37
  38(defvar compilation-current-error)
  39
  40(defcustom idle-update-delay 0.5
  41  "Idle time delay before updating various things on the screen.
  42Various Emacs features that update auxiliary information when point moves
  43wait this many seconds after Emacs becomes idle before doing an update."
  44  :type 'number
  45  :group 'display
  46  :version "22.1")
  47
  48(defgroup killing nil
  49  "Killing and yanking commands."
  50  :group 'editing)
  51
  52(defgroup paren-matching nil
  53  "Highlight (un)matching of parens and expressions."
  54  :group 'matching)
  55
  56(defun get-next-valid-buffer (list &optional buffer visible-ok frame)
  57  "Search LIST for a valid buffer to display in FRAME.
  58Return nil when all buffers in LIST are undesirable for display,
  59otherwise return the first suitable buffer in LIST.
  60
  61Buffers not visible in windows are preferred to visible buffers,
  62unless VISIBLE-OK is non-nil.
  63If the optional argument FRAME is nil, it defaults to the selected frame.
  64If BUFFER is non-nil, ignore occurrences of that buffer in LIST."
  65  ;; This logic is more or less copied from other-buffer.
  66  (setq frame (or frame (selected-frame)))
  67  (let ((pred (frame-parameter frame 'buffer-predicate))
  68	found buf)
  69    (while (and (not found) list)
  70      (setq buf (car list))
  71      (if (and (not (eq buffer buf))
  72	       (buffer-live-p buf)
  73	       (or (null pred) (funcall pred buf))
  74	       (not (eq (aref (buffer-name buf) 0) ?\s))
  75	       (or visible-ok (null (get-buffer-window buf 'visible))))
  76	  (setq found buf)
  77	(setq list (cdr list))))
  78    (car list)))
  79
  80(defun last-buffer (&optional buffer visible-ok frame)
  81  "Return the last buffer in FRAME's buffer list.
  82If BUFFER is the last buffer, return the preceding buffer instead.
  83Buffers not visible in windows are preferred to visible buffers,
  84unless optional argument VISIBLE-OK is non-nil.
  85Optional third argument FRAME nil or omitted means use the
  86selected frame's buffer list.
  87If no such buffer exists, return the buffer `*scratch*', creating
  88it if necessary."
  89  (setq frame (or frame (selected-frame)))
  90  (or (get-next-valid-buffer (nreverse (buffer-list frame))
  91 			     buffer visible-ok frame)
  92      (get-buffer "*scratch*")
  93      (let ((scratch (get-buffer-create "*scratch*")))
  94	(set-buffer-major-mode scratch)
  95	scratch)))
  96
  97(defun next-buffer ()
  98  "Switch to the next buffer in cyclic order."
  99  (interactive)
 100  (let ((buffer (current-buffer)))
 101    (switch-to-buffer (other-buffer buffer t))
 102    (bury-buffer buffer)))
 103
 104(defun previous-buffer ()
 105  "Switch to the previous buffer in cyclic order."
 106  (interactive)
 107  (switch-to-buffer (last-buffer (current-buffer) t)))
 108
 109
 110;;; next-error support framework
 111
 112(defgroup next-error nil
 113  "`next-error' support framework."
 114  :group 'compilation
 115  :version "22.1")
 116
 117(defface next-error
 118  '((t (:inherit region)))
 119  "Face used to highlight next error locus."
 120  :group 'next-error
 121  :version "22.1")
 122
 123(defcustom next-error-highlight 0.5
 124  "Highlighting of locations in selected source buffers.
 125If a number, highlight the locus in `next-error' face for the given time
 126in seconds, or until the next command is executed.
 127If t, highlight the locus until the next command is executed, or until
 128some other locus replaces it.
 129If nil, don't highlight the locus in the source buffer.
 130If `fringe-arrow', indicate the locus by the fringe arrow."
 131  :type '(choice (number :tag "Highlight for specified time")
 132                 (const :tag "Semipermanent highlighting" t)
 133                 (const :tag "No highlighting" nil)
 134                 (const :tag "Fringe arrow" fringe-arrow))
 135  :group 'next-error
 136  :version "22.1")
 137
 138(defcustom next-error-highlight-no-select 0.5
 139  "Highlighting of locations in `next-error-no-select'.
 140If number, highlight the locus in `next-error' face for given time in seconds.
 141If t, highlight the locus indefinitely until some other locus replaces it.
 142If nil, don't highlight the locus in the source buffer.
 143If `fringe-arrow', indicate the locus by the fringe arrow."
 144  :type '(choice (number :tag "Highlight for specified time")
 145                 (const :tag "Semipermanent highlighting" t)
 146                 (const :tag "No highlighting" nil)
 147                 (const :tag "Fringe arrow" fringe-arrow))
 148  :group 'next-error
 149  :version "22.1")
 150
 151(defcustom next-error-recenter nil
 152  "Display the line in the visited source file recentered as specified.
 153If non-nil, the value is passed directly to `recenter'."
 154  :type '(choice (integer :tag "Line to recenter to")
 155                 (const :tag "Center of window" (4))
 156                 (const :tag "No recentering" nil))
 157  :group 'next-error
 158  :version "23.1")
 159
 160(defcustom next-error-hook nil
 161  "List of hook functions run by `next-error' after visiting source file."
 162  :type 'hook
 163  :group 'next-error)
 164
 165(defvar next-error-highlight-timer nil)
 166
 167(defvar next-error-overlay-arrow-position nil)
 168(put 'next-error-overlay-arrow-position 'overlay-arrow-string "=>")
 169(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)
 170
 171(defvar next-error-last-buffer nil
 172  "The most recent `next-error' buffer.
 173A buffer becomes most recent when its compilation, grep, or
 174similar mode is started, or when it is used with \\[next-error]
 175or \\[compile-goto-error].")
 176
 177(defvar next-error-function nil
 178  "Function to use to find the next error in the current buffer.
 179The function is called with 2 parameters:
 180ARG is an integer specifying by how many errors to move.
 181RESET is a boolean which, if non-nil, says to go back to the beginning
 182of the errors before moving.
 183Major modes providing compile-like functionality should set this variable
 184to indicate to `next-error' that this is a candidate buffer and how
 185to navigate in it.")
 186(make-variable-buffer-local 'next-error-function)
 187
 188(defvar next-error-move-function nil
 189  "Function to use to move to an error locus.
 190It takes two arguments, a buffer position in the error buffer
 191and a buffer position in the error locus buffer.
 192The buffer for the error locus should already be current.
 193nil means use goto-char using the second argument position.")
 194(make-variable-buffer-local 'next-error-move-function)
 195
 196(defsubst next-error-buffer-p (buffer
 197			       &optional avoid-current
 198			       extra-test-inclusive
 199			       extra-test-exclusive)
 200  "Test if BUFFER is a `next-error' capable buffer.
 201
 202If AVOID-CURRENT is non-nil, treat the current buffer
 203as an absolute last resort only.
 204
 205The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
 206that normally would not qualify.  If it returns t, the buffer
 207in question is treated as usable.
 208
 209The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
 210that would normally be considered usable.  If it returns nil,
 211that buffer is rejected."
 212  (and (buffer-name buffer)		;First make sure it's live.
 213       (not (and avoid-current (eq buffer (current-buffer))))
 214       (with-current-buffer buffer
 215	 (if next-error-function   ; This is the normal test.
 216	     ;; Optionally reject some buffers.
 217	     (if extra-test-exclusive
 218		 (funcall extra-test-exclusive)
 219	       t)
 220	   ;; Optionally accept some other buffers.
 221	   (and extra-test-inclusive
 222		(funcall extra-test-inclusive))))))
 223
 224(defun next-error-find-buffer (&optional avoid-current
 225					 extra-test-inclusive
 226					 extra-test-exclusive)
 227  "Return a `next-error' capable buffer.
 228
 229If AVOID-CURRENT is non-nil, treat the current buffer
 230as an absolute last resort only.
 231
 232The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
 233that normally would not qualify.  If it returns t, the buffer
 234in question is treated as usable.
 235
 236The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
 237that would normally be considered usable.  If it returns nil,
 238that buffer is rejected."
 239  (or
 240   ;; 1. If one window on the selected frame displays such buffer, return it.
 241   (let ((window-buffers
 242          (delete-dups
 243           (delq nil (mapcar (lambda (w)
 244                               (if (next-error-buffer-p
 245				    (window-buffer w)
 246                                    avoid-current
 247                                    extra-test-inclusive extra-test-exclusive)
 248                                   (window-buffer w)))
 249                             (window-list))))))
 250     (if (eq (length window-buffers) 1)
 251         (car window-buffers)))
 252   ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
 253   (if (and next-error-last-buffer
 254            (next-error-buffer-p next-error-last-buffer avoid-current
 255                                 extra-test-inclusive extra-test-exclusive))
 256       next-error-last-buffer)
 257   ;; 3. If the current buffer is acceptable, choose it.
 258   (if (next-error-buffer-p (current-buffer) avoid-current
 259			    extra-test-inclusive extra-test-exclusive)
 260       (current-buffer))
 261   ;; 4. Look for any acceptable buffer.
 262   (let ((buffers (buffer-list)))
 263     (while (and buffers
 264                 (not (next-error-buffer-p
 265		       (car buffers) avoid-current
 266		       extra-test-inclusive extra-test-exclusive)))
 267       (setq buffers (cdr buffers)))
 268     (car buffers))
 269   ;; 5. Use the current buffer as a last resort if it qualifies,
 270   ;; even despite AVOID-CURRENT.
 271   (and avoid-current
 272	(next-error-buffer-p (current-buffer) nil
 273			     extra-test-inclusive extra-test-exclusive)
 274	(progn
 275	  (message "This is the only buffer with error message locations")
 276	  (current-buffer)))
 277   ;; 6. Give up.
 278   (error "No buffers contain error message locations")))
 279
 280(defun next-error (&optional arg reset)
 281  "Visit next `next-error' message and corresponding source code.
 282
 283If all the error messages parsed so far have been processed already,
 284the message buffer is checked for new ones.
 285
 286A prefix ARG specifies how many error messages to move;
 287negative means move back to previous error messages.
 288Just \\[universal-argument] as a prefix means reparse the error message buffer
 289and start at the first error.
 290
 291The RESET argument specifies that we should restart from the beginning.
 292
 293\\[next-error] normally uses the most recently started
 294compilation, grep, or occur buffer.  It can also operate on any
 295buffer with output from the \\[compile], \\[grep] commands, or,
 296more generally, on any buffer in Compilation mode or with
 297Compilation Minor mode enabled, or any buffer in which
 298`next-error-function' is bound to an appropriate function.
 299To specify use of a particular buffer for error messages, type
 300\\[next-error] in that buffer when it is the only one displayed
 301in the current frame.
 302
 303Once \\[next-error] has chosen the buffer for error messages, it
 304runs `next-error-hook' with `run-hooks', and stays with that buffer
 305until you use it in some other buffer which uses Compilation mode
 306or Compilation Minor mode.
 307
 308See variables `compilation-parse-errors-function' and
 309\`compilation-error-regexp-alist' for customization ideas."
 310  (interactive "P")
 311  (if (consp arg) (setq reset t arg nil))
 312  (when (setq next-error-last-buffer (next-error-find-buffer))
 313    ;; we know here that next-error-function is a valid symbol we can funcall
 314    (with-current-buffer next-error-last-buffer
 315      (funcall next-error-function (prefix-numeric-value arg) reset)
 316      (when next-error-recenter
 317        (recenter next-error-recenter))
 318      (run-hooks 'next-error-hook))))
 319
 320(defun next-error-internal ()
 321  "Visit the source code corresponding to the `next-error' message at point."
 322  (setq next-error-last-buffer (current-buffer))
 323  ;; we know here that next-error-function is a valid symbol we can funcall
 324  (with-current-buffer next-error-last-buffer
 325    (funcall next-error-function 0 nil)
 326    (when next-error-recenter
 327      (recenter next-error-recenter))
 328    (run-hooks 'next-error-hook)))
 329
 330(defalias 'goto-next-locus 'next-error)
 331(defalias 'next-match 'next-error)
 332
 333(defun previous-error (&optional n)
 334  "Visit previous `next-error' message and corresponding source code.
 335
 336Prefix arg N says how many error messages to move backwards (or
 337forwards, if negative).
 338
 339This operates on the output from the \\[compile] and \\[grep] commands."
 340  (interactive "p")
 341  (next-error (- (or n 1))))
 342
 343(defun first-error (&optional n)
 344  "Restart at the first error.
 345Visit corresponding source code.
 346With prefix arg N, visit the source code of the Nth error.
 347This operates on the output from the \\[compile] command, for instance."
 348  (interactive "p")
 349  (next-error n t))
 350
 351(defun next-error-no-select (&optional n)
 352  "Move point to the next error in the `next-error' buffer and highlight match.
 353Prefix arg N says how many error messages to move forwards (or
 354backwards, if negative).
 355Finds and highlights the source line like \\[next-error], but does not
 356select the source buffer."
 357  (interactive "p")
 358  (let ((next-error-highlight next-error-highlight-no-select))
 359    (next-error n))
 360  (pop-to-buffer next-error-last-buffer))
 361
 362(defun previous-error-no-select (&optional n)
 363  "Move point to the previous error in the `next-error' buffer and highlight match.
 364Prefix arg N says how many error messages to move backwards (or
 365forwards, if negative).
 366Finds and highlights the source line like \\[previous-error], but does not
 367select the source buffer."
 368  (interactive "p")
 369  (next-error-no-select (- (or n 1))))
 370
 371;; Internal variable for `next-error-follow-mode-post-command-hook'.
 372(defvar next-error-follow-last-line nil)
 373
 374(define-minor-mode next-error-follow-minor-mode
 375  "Minor mode for compilation, occur and diff modes.
 376When turned on, cursor motion in the compilation, grep, occur or diff
 377buffer causes automatic display of the corresponding source code
 378location."
 379  :group 'next-error :init-value nil :lighter " Fol"
 380  (if (not next-error-follow-minor-mode)
 381      (remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t)
 382    (add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t)
 383    (make-local-variable 'next-error-follow-last-line)))
 384
 385;; Used as a `post-command-hook' by `next-error-follow-mode'
 386;; for the *Compilation* *grep* and *Occur* buffers.
 387(defun next-error-follow-mode-post-command-hook ()
 388  (unless (equal next-error-follow-last-line (line-number-at-pos))
 389    (setq next-error-follow-last-line (line-number-at-pos))
 390    (condition-case nil
 391	(let ((compilation-context-lines nil))
 392	  (setq compilation-current-error (point))
 393	  (next-error-no-select 0))
 394      (error t))))
 395
 396
 397;;;
 398
 399(defun fundamental-mode ()
 400  "Major mode not specialized for anything in particular.
 401Other major modes are defined by comparison with this one."
 402  (interactive)
 403  (kill-all-local-variables)
 404  (unless delay-mode-hooks
 405    (run-hooks 'after-change-major-mode-hook)))
 406
 407;; Special major modes to view specially formatted data rather than files.
 408
 409(defvar special-mode-map
 410  (let ((map (make-sparse-keymap)))
 411    (suppress-keymap map)
 412    (define-key map "q" 'quit-window)
 413    (define-key map " " 'scroll-up)
 414    (define-key map "\C-?" 'scroll-down)
 415    (define-key map "?" 'describe-mode)
 416    (define-key map ">" 'end-of-buffer)
 417    (define-key map "<" 'beginning-of-buffer)
 418    (define-key map "g" 'revert-buffer)
 419    map))
 420
 421(put 'special-mode 'mode-class 'special)
 422(define-derived-mode special-mode nil "Special"
 423  "Parent major mode from which special major modes should inherit."
 424  (setq buffer-read-only t))
 425
 426;; Making and deleting lines.
 427
 428(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
 429  "Propertized string representing a hard newline character.")
 430
 431(defun newline (&optional arg)
 432  "Insert a newline, and move to left margin of the new line if it's blank.
 433If `use-hard-newlines' is non-nil, the newline is marked with the
 434text-property `hard'.
 435With ARG, insert that many newlines.
 436Call `auto-fill-function' if the current column number is greater
 437than the value of `fill-column' and ARG is nil."
 438  (interactive "*P")
 439  (barf-if-buffer-read-only)
 440  ;; Inserting a newline at the end of a line produces better redisplay in
 441  ;; try_window_id than inserting at the beginning of a line, and the textual
 442  ;; result is the same.  So, if we're at beginning of line, pretend to be at
 443  ;; the end of the previous line.
 444  (let ((flag (and (not (bobp))
 445		   (bolp)
 446		   ;; Make sure no functions want to be told about
 447		   ;; the range of the changes.
 448		   (not after-change-functions)
 449		   (not before-change-functions)
 450		   ;; Make sure there are no markers here.
 451		   (not (buffer-has-markers-at (1- (point))))
 452		   (not (buffer-has-markers-at (point)))
 453		   ;; Make sure no text properties want to know
 454		   ;; where the change was.
 455		   (not (get-char-property (1- (point)) 'modification-hooks))
 456		   (not (get-char-property (1- (point)) 'insert-behind-hooks))
 457		   (or (eobp)
 458		       (not (get-char-property (point) 'insert-in-front-hooks)))
 459		   ;; Make sure the newline before point isn't intangible.
 460		   (not (get-char-property (1- (point)) 'intangible))
 461		   ;; Make sure the newline before point isn't read-only.
 462		   (not (get-char-property (1- (point)) 'read-only))
 463		   ;; Make sure the newline before point isn't invisible.
 464		   (not (get-char-property (1- (point)) 'invisible))
 465		   ;; Make sure the newline before point has the same
 466		   ;; properties as the char before it (if any).
 467		   (< (or (previous-property-change (point)) -2)
 468		      (- (point) 2))))
 469	(was-page-start (and (bolp)
 470			     (looking-at page-delimiter)))
 471	(beforepos (point)))
 472    (if flag (backward-char 1))
 473    ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
 474    ;; Set last-command-event to tell self-insert what to insert.
 475    (let ((last-command-event ?\n)
 476	  ;; Don't auto-fill if we have a numeric argument.
 477	  ;; Also not if flag is true (it would fill wrong line);
 478	  ;; there is no need to since we're at BOL.
 479	  (auto-fill-function (if (or arg flag) nil auto-fill-function)))
 480      (unwind-protect
 481	  (self-insert-command (prefix-numeric-value arg))
 482	;; If we get an error in self-insert-command, put point at right place.
 483	(if flag (forward-char 1))))
 484    ;; Even if we did *not* get an error, keep that forward-char;
 485    ;; all further processing should apply to the newline that the user
 486    ;; thinks he inserted.
 487
 488    ;; Mark the newline(s) `hard'.
 489    (if use-hard-newlines
 490	(set-hard-newline-properties
 491	 (- (point) (prefix-numeric-value arg)) (point)))
 492    ;; If the newline leaves the previous line blank,
 493    ;; and we have a left margin, delete that from the blank line.
 494    (or flag
 495	(save-excursion
 496	  (goto-char beforepos)
 497	  (beginning-of-line)
 498	  (and (looking-at "[ \t]$")
 499	       (> (current-left-margin) 0)
 500	       (delete-region (point) (progn (end-of-line) (point))))))
 501    ;; Indent the line after the newline, except in one case:
 502    ;; when we added the newline at the beginning of a line
 503    ;; which starts a page.
 504    (or was-page-start
 505	(move-to-left-margin nil t)))
 506  nil)
 507
 508(defun set-hard-newline-properties (from to)
 509  (let ((sticky (get-text-property from 'rear-nonsticky)))
 510    (put-text-property from to 'hard 't)
 511    ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
 512    (if (and (listp sticky) (not (memq 'hard sticky)))
 513	(put-text-property from (point) 'rear-nonsticky
 514			   (cons 'hard sticky)))))
 515
 516(defun open-line (n)
 517  "Insert a newline and leave point before it.
 518If there is a fill prefix and/or a `left-margin', insert them
 519on the new line if the line would have been blank.
 520With arg N, insert N newlines."
 521  (interactive "*p")
 522  (let* ((do-fill-prefix (and fill-prefix (bolp)))
 523	 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
 524	 (loc (point))
 525	 ;; Don't expand an abbrev before point.
 526	 (abbrev-mode nil))
 527    (newline n)
 528    (goto-char loc)
 529    (while (> n 0)
 530      (cond ((bolp)
 531	     (if do-left-margin (indent-to (current-left-margin)))
 532	     (if do-fill-prefix (insert-and-inherit fill-prefix))))
 533      (forward-line 1)
 534      (setq n (1- n)))
 535    (goto-char loc)
 536    (end-of-line)))
 537
 538(defun split-line (&optional arg)
 539  "Split current line, moving portion beyond point vertically down.
 540If the current line starts with `fill-prefix', insert it on the new
 541line as well.  With prefix ARG, don't insert `fill-prefix' on new line.
 542
 543When called from Lisp code, ARG may be a prefix string to copy."
 544  (interactive "*P")
 545  (skip-chars-forward " \t")
 546  (let* ((col (current-column))
 547	 (pos (point))
 548	 ;; What prefix should we check for (nil means don't).
 549	 (prefix (cond ((stringp arg) arg)
 550		       (arg nil)
 551		       (t fill-prefix)))
 552	 ;; Does this line start with it?
 553	 (have-prfx (and prefix
 554			 (save-excursion
 555			   (beginning-of-line)
 556			   (looking-at (regexp-quote prefix))))))
 557    (newline 1)
 558    (if have-prfx (insert-and-inherit prefix))
 559    (indent-to col 0)
 560    (goto-char pos)))
 561
 562(defun delete-indentation (&optional arg)
 563  "Join this line to previous and fix up whitespace at join.
 564If there is a fill prefix, delete it from the beginning of this line.
 565With argument, join this line to following line."
 566  (interactive "*P")
 567  (beginning-of-line)
 568  (if arg (forward-line 1))
 569  (if (eq (preceding-char) ?\n)
 570      (progn
 571	(delete-region (point) (1- (point)))
 572	;; If the second line started with the fill prefix,
 573	;; delete the prefix.
 574	(if (and fill-prefix
 575		 (<= (+ (point) (length fill-prefix)) (point-max))
 576		 (string= fill-prefix
 577			  (buffer-substring (point)
 578					    (+ (point) (length fill-prefix)))))
 579	    (delete-region (point) (+ (point) (length fill-prefix))))
 580	(fixup-whitespace))))
 581
 582(defalias 'join-line #'delete-indentation) ; easier to find
 583
 584(defun delete-blank-lines ()
 585  "On blank line, delete all surrounding blank lines, leaving just one.
 586On isolated blank line, delete that one.
 587On nonblank line, delete any immediately following blank lines."
 588  (interactive "*")
 589  (let (thisblank singleblank)
 590    (save-excursion
 591      (beginning-of-line)
 592      (setq thisblank (looking-at "[ \t]*$"))
 593      ;; Set singleblank if there is just one blank line here.
 594      (setq singleblank
 595	    (and thisblank
 596		 (not (looking-at "[ \t]*\n[ \t]*$"))
 597		 (or (bobp)
 598		     (progn (forward-line -1)
 599			    (not (looking-at "[ \t]*$")))))))
 600    ;; Delete preceding blank lines, and this one too if it's the only one.
 601    (if thisblank
 602	(progn
 603	  (beginning-of-line)
 604	  (if singleblank (forward-line 1))
 605	  (delete-region (point)
 606			 (if (re-search-backward "[^ \t\n]" nil t)
 607			     (progn (forward-line 1) (point))
 608			   (point-min)))))
 609    ;; Delete following blank lines, unless the current line is blank
 610    ;; and there are no following blank lines.
 611    (if (not (and thisblank singleblank))
 612	(save-excursion
 613	  (end-of-line)
 614	  (forward-line 1)
 615	  (delete-region (point)
 616			 (if (re-search-forward "[^ \t\n]" nil t)
 617			     (progn (beginning-of-line) (point))
 618			   (point-max)))))
 619    ;; Handle the special case where point is followed by newline and eob.
 620    ;; Delete the line, leaving point at eob.
 621    (if (looking-at "^[ \t]*\n\\'")
 622	(delete-region (point) (point-max)))))
 623
 624(defun delete-trailing-whitespace ()
 625  "Delete all the trailing whitespace across the current buffer.
 626All whitespace after the last non-whitespace character in a line is deleted.
 627This respects narrowing, created by \\[narrow-to-region] and friends.
 628A formfeed is not considered whitespace by this function."
 629  (interactive "*")
 630  (save-match-data
 631    (save-excursion
 632      (goto-char (point-min))
 633      (while (re-search-forward "\\s-$" nil t)
 634	(skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
 635	;; Don't delete formfeeds, even if they are considered whitespace.
 636	(save-match-data
 637	  (if (looking-at ".*\f")
 638	      (goto-char (match-end 0))))
 639	(delete-region (point) (match-end 0))))))
 640
 641(defun newline-and-indent ()
 642  "Insert a newline, then indent according to major mode.
 643Indentation is done using the value of `indent-line-function'.
 644In programming language modes, this is the same as TAB.
 645In some text modes, where TAB inserts a tab, this command indents to the
 646column specified by the function `current-left-margin'."
 647  (interactive "*")
 648  (delete-horizontal-space t)
 649  (newline)
 650  (indent-according-to-mode))
 651
 652(defun reindent-then-newline-and-indent ()
 653  "Reindent current line, insert newline, then indent the new line.
 654Indentation of both lines is done according to the current major mode,
 655which means calling the current value of `indent-line-function'.
 656In programming language modes, this is the same as TAB.
 657In some text modes, where TAB inserts a tab, this indents to the
 658column specified by the function `current-left-margin'."
 659  (interactive "*")
 660  (let ((pos (point)))
 661    ;; Be careful to insert the newline before indenting the line.
 662    ;; Otherwise, the indentation might be wrong.
 663    (newline)
 664    (save-excursion
 665      (goto-char pos)
 666      ;; We are at EOL before the call to indent-according-to-mode, and
 667      ;; after it we usually are as well, but not always.  We tried to
 668      ;; address it with `save-excursion' but that uses a normal marker
 669      ;; whereas we need `move after insertion', so we do the save/restore
 670      ;; by hand.
 671      (setq pos (copy-marker pos t))
 672      (indent-according-to-mode)
 673      (goto-char pos)
 674      ;; Remove the trailing white-space after indentation because
 675      ;; indentation may introduce the whitespace.
 676      (delete-horizontal-space t))
 677    (indent-according-to-mode)))
 678
 679(defun quoted-insert (arg)
 680  "Read next input character and insert it.
 681This is useful for inserting control characters.
 682With argument, insert ARG copies of the character.
 683
 684If the first character you type after this command is an octal digit,
 685you should type a sequence of octal digits which specify a character code.
 686Any nondigit terminates the sequence.  If the terminator is a RET,
 687it is discarded; any other terminator is used itself as input.
 688The variable `read-quoted-char-radix' specifies the radix for this feature;
 689set it to 10 or 16 to use decimal or hex instead of octal.
 690
 691In overwrite mode, this function inserts the character anyway, and
 692does not handle octal digits specially.  This means that if you use
 693overwrite as your normal editing mode, you can use this function to
 694insert characters when necessary.
 695
 696In binary overwrite mode, this function does overwrite, and octal
 697digits are interpreted as a character code.  This is intended to be
 698useful for editing binary files."
 699  (interactive "*p")
 700  (let* ((char
 701	  ;; Avoid "obsolete" warnings for translation-table-for-input.
 702	  (with-no-warnings
 703	    (let (translation-table-for-input input-method-function)
 704	      (if (or (not overwrite-mode)
 705		      (eq overwrite-mode 'overwrite-mode-binary))
 706		  (read-quoted-char)
 707		(read-char))))))
 708    ;; This used to assume character codes 0240 - 0377 stand for
 709    ;; characters in some single-byte character set, and converted them
 710    ;; to Emacs characters.  But in 23.1 this feature is deprecated
 711    ;; in favor of inserting the corresponding Unicode characters.
 712    ;; (if (and enable-multibyte-characters
 713    ;;          (>= char ?\240)
 714    ;;          (<= char ?\377))
 715    ;;     (setq char (unibyte-char-to-multibyte char)))
 716    (if (> arg 0)
 717	(if (eq overwrite-mode 'overwrite-mode-binary)
 718	    (delete-char arg)))
 719    (while (> arg 0)
 720      (insert-and-inherit char)
 721      (setq arg (1- arg)))))
 722
 723(defun forward-to-indentation (&optional arg)
 724  "Move forward ARG lines and position at first nonblank character."
 725  (interactive "^p")
 726  (forward-line (or arg 1))
 727  (skip-chars-forward " \t"))
 728
 729(defun backward-to-indentation (&optional arg)
 730  "Move backward ARG lines and position at first nonblank character."
 731  (interactive "^p")
 732  (forward-line (- (or arg 1)))
 733  (skip-chars-forward " \t"))
 734
 735(defun back-to-indentation ()
 736  "Move point to the first non-whitespace character on this line."
 737  (interactive "^")
 738  (beginning-of-line 1)
 739  (skip-syntax-forward " " (line-end-position))
 740  ;; Move back over chars that have whitespace syntax but have the p flag.
 741  (backward-prefix-chars))
 742
 743(defun fixup-whitespace ()
 744  "Fixup white space between objects around point.
 745Leave one space or none, according to the context."
 746  (interactive "*")
 747  (save-excursion
 748    (delete-horizontal-space)
 749    (if (or (looking-at "^\\|\\s)")
 750	    (save-excursion (forward-char -1)
 751			    (looking-at "$\\|\\s(\\|\\s'")))
 752	nil
 753      (insert ?\s))))
 754
 755(defun delete-horizontal-space (&optional backward-only)
 756  "Delete all spaces and tabs around point.
 757If BACKWARD-ONLY is non-nil, only delete them before point."
 758  (interactive "*P")
 759  (let ((orig-pos (point)))
 760    (delete-region
 761     (if backward-only
 762	 orig-pos
 763       (progn
 764	 (skip-chars-forward " \t")
 765	 (constrain-to-field nil orig-pos t)))
 766     (progn
 767       (skip-chars-backward " \t")
 768       (constrain-to-field nil orig-pos)))))
 769
 770(defun just-one-space (&optional n)
 771  "Delete all spaces and tabs around point, leaving one space (or N spaces)."
 772  (interactive "*p")
 773  (let ((orig-pos (point)))
 774    (skip-chars-backward " \t")
 775    (constrain-to-field nil orig-pos)
 776    (dotimes (i (or n 1))
 777      (if (= (following-char) ?\s)
 778	  (forward-char 1)
 779	(insert ?\s)))
 780    (delete-region
 781     (point)
 782     (progn
 783       (skip-chars-forward " \t")
 784       (constrain-to-field nil orig-pos t)))))
 785
 786(defun beginning-of-buffer (&optional arg)
 787  "Move point to the beginning of the buffer; leave mark at previous position.
 788With \\[universal-argument] prefix, do not set mark at previous position.
 789With numeric arg N, put point N/10 of the way from the beginning.
 790
 791If the buffer is narrowed, this command uses the beginning and size
 792of the accessible part of the buffer.
 793
 794Don't use this command in Lisp programs!
 795\(goto-char (point-min)) is faster and avoids clobbering the mark."
 796  (interactive "^P")
 797  (or (consp arg)
 798      (region-active-p)
 799      (push-mark))
 800  (let ((size (- (point-max) (point-min))))
 801    (goto-char (if (and arg (not (consp arg)))
 802		   (+ (point-min)
 803		      (if (> size 10000)
 804			  ;; Avoid overflow for large buffer sizes!
 805			  (* (prefix-numeric-value arg)
 806			     (/ size 10))
 807			(/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
 808		 (point-min))))
 809  (if (and arg (not (consp arg))) (forward-line 1)))
 810
 811(defun end-of-buffer (&optional arg)
 812  "Move point to the end of the buffer; leave mark at previous position.
 813With \\[universal-argument] prefix, do not set mark at previous position.
 814With numeric arg N, put point N/10 of the way from the end.
 815
 816If the buffer is narrowed, this command uses the beginning and size
 817of the accessible part of the buffer.
 818
 819Don't use this command in Lisp programs!
 820\(goto-char (point-max)) is faster and avoids clobbering the mark."
 821  (interactive "^P")
 822  (or (consp arg) (region-active-p) (push-mark))
 823  (let ((size (- (point-max) (point-min))))
 824    (goto-char (if (and arg (not (consp arg)))
 825		   (- (point-max)
 826		      (if (> size 10000)
 827			  ;; Avoid overflow for large buffer sizes!
 828			  (* (prefix-numeric-value arg)
 829			     (/ size 10))
 830			(/ (* size (prefix-numeric-value arg)) 10)))
 831		 (point-max))))
 832  ;; If we went to a place in the middle of the buffer,
 833  ;; adjust it to the beginning of a line.
 834  (cond ((and arg (not (consp arg))) (forward-line 1))
 835	((> (point) (window-end nil t))
 836	 ;; If the end of the buffer is not already on the screen,
 837	 ;; then scroll specially to put it near, but not at, the bottom.
 838	 (overlay-recenter (point))
 839	 (recenter -3))))
 840
 841(defun mark-whole-buffer ()
 842  "Put point at beginning and mark at end of buffer.
 843You probably should not use this function in Lisp programs;
 844it is usually a mistake for a Lisp function to use any subroutine
 845that uses or sets the mark."
 846  (interactive)
 847  (push-mark (point))
 848  (push-mark (point-max) nil t)
 849  (goto-char (point-min)))
 850
 851
 852;; Counting lines, one way or another.
 853
 854(defun goto-line (line &optional buffer)
 855  "Goto LINE, counting from line 1 at beginning of buffer.
 856Normally, move point in the current buffer, and leave mark at the
 857previous position.  With just \\[universal-argument] as argument,
 858move point in the most recently selected other buffer, and switch to it.
 859
 860If there's a number in the buffer at point, it is the default for LINE.
 861
 862This function is usually the wrong thing to use in a Lisp program.
 863What you probably want instead is something like:
 864  (goto-char (point-min)) (forward-line (1- N))
 865If at all possible, an even better solution is to use char counts
 866rather than line counts."
 867  (interactive
 868   (if (and current-prefix-arg (not (consp current-prefix-arg)))
 869       (list (prefix-numeric-value current-prefix-arg))
 870     ;; Look for a default, a number in the buffer at point.
 871     (let* ((default
 872	      (save-excursion
 873		(skip-chars-backward "0-9")
 874		(if (looking-at "[0-9]")
 875		    (buffer-substring-no-properties
 876		     (point)
 877		     (progn (skip-chars-forward "0-9")
 878			    (point))))))
 879	    ;; Decide if we're switching buffers.
 880	    (buffer
 881	     (if (consp current-prefix-arg)
 882		 (other-buffer (current-buffer) t)))
 883	    (buffer-prompt
 884	     (if buffer
 885		 (concat " in " (buffer-name buffer))
 886	       "")))
 887       ;; Read the argument, offering that number (if any) as default.
 888       (list (read-from-minibuffer (format (if default "Goto line%s (%s): "
 889					     "Goto line%s: ")
 890					   buffer-prompt
 891					   default)
 892				   nil nil t
 893				   'minibuffer-history
 894				   default)
 895	     buffer))))
 896  ;; Switch to the desired buffer, one way or another.
 897  (if buffer
 898      (let ((window (get-buffer-window buffer)))
 899	(if window (select-window window)
 900	  (switch-to-buffer-other-window buffer))))
 901  ;; Leave mark at previous position
 902  (or (region-active-p) (push-mark))
 903  ;; Move to the specified line number in that buffer.
 904  (save-restriction
 905    (widen)
 906    (goto-char (point-min))
 907    (if (eq selective-display t)
 908	(re-search-forward "[\n\C-m]" nil 'end (1- line))
 909      (forward-line (1- line)))))
 910
 911(defun count-lines-region (start end)
 912  "Print number of lines and characters in the region."
 913  (interactive "r")
 914  (message "Region has %d lines, %d characters"
 915	   (count-lines start end) (- end start)))
 916
 917(defun what-line ()
 918  "Print the current buffer line number and narrowed line number of point."
 919  (interactive)
 920  (let ((start (point-min))
 921	(n (line-number-at-pos)))
 922    (if (= start 1)
 923	(message "Line %d" n)
 924      (save-excursion
 925	(save-restriction
 926	  (widen)
 927	  (message "line %d (narrowed line %d)"
 928		   (+ n (line-number-at-pos start) -1) n))))))
 929
 930(defun count-lines (start end)
 931  "Return number of lines between START and END.
 932This is usually the number of newlines between them,
 933but can be one more if START is not equal to END
 934and the greater of them is not at the start of a line."
 935  (save-excursion
 936    (save-restriction
 937      (narrow-to-region start end)
 938      (goto-char (point-min))
 939      (if (eq selective-display t)
 940	  (save-match-data
 941	    (let ((done 0))
 942	      (while (re-search-forward "[\n\C-m]" nil t 40)
 943		(setq done (+ 40 done)))
 944	      (while (re-search-forward "[\n\C-m]" nil t 1)
 945		(setq done (+ 1 done)))
 946	      (goto-char (point-max))
 947	      (if (and (/= start end)
 948		       (not (bolp)))
 949		  (1+ done)
 950		done)))
 951	(- (buffer-size) (forward-line (buffer-size)))))))
 952
 953(defun line-number-at-pos (&optional pos)
 954  "Return (narrowed) buffer line number at position POS.
 955If POS is nil, use current buffer location.
 956Counting starts at (point-min), so the value refers
 957to the contents of the accessible portion of the buffer."
 958  (let ((opoint (or pos (point))) start)
 959    (save-excursion
 960      (goto-char (point-min))
 961      (setq start (point))
 962      (goto-char opoint)
 963      (forward-line 0)
 964      (1+ (count-lines start (point))))))
 965
 966(defun what-cursor-position (&optional detail)
 967  "Print info on cursor position (on screen and within buffer).
 968Also describe the character after point, and give its character code
 969in octal, decimal and hex.
 970
 971For a non-ASCII multibyte character, also give its encoding in the
 972buffer's selected coding system if the coding system encodes the
 973character safely.  If the character is encoded into one byte, that
 974code is shown in hex.  If the character is encoded into more than one
 975byte, just \"...\" is shown.
 976
 977In addition, with prefix argument, show details about that character
 978in *Help* buffer.  See also the command `describe-char'."
 979  (interactive "P")
 980  (let* ((char (following-char))
 981	 (beg (point-min))
 982	 (end (point-max))
 983         (pos (point))
 984	 (total (buffer-size))
 985	 (percent (if (> total 50000)
 986		      ;; Avoid overflow from multiplying by 100!
 987		      (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
 988		    (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
 989	 (hscroll (if (= (window-hscroll) 0)
 990		      ""
 991		    (format " Hscroll=%d" (window-hscroll))))
 992	 (col (current-column)))
 993    (if (= pos end)
 994	(if (or (/= beg 1) (/= end (1+ total)))
 995	    (message "point=%d of %d (%d%%) <%d-%d> column=%d%s"
 996		     pos total percent beg end col hscroll)
 997	  (message "point=%d of %d (EOB) column=%d%s"
 998		   pos total col hscroll))
 999      (let ((coding buffer-file-coding-system)
1000	    encoded encoding-msg display-prop under-display)
1001	(if (or (not coding)
1002		(eq (coding-system-type coding) t))
1003	    (setq coding (default-value 'buffer-file-coding-system)))
1004	(if (eq (char-charset char) 'eight-bit)
1005	    (setq encoding-msg
1006		  (format "(%d, #o%o, #x%x, raw-byte)" char char char))
1007	  ;; Check if the character is displayed with some `display'
1008	  ;; text property.  In that case, set under-display to the
1009	  ;; buffer substring covered by that property.
1010	  (setq display-prop (get-text-property pos 'display))
1011	  (if display-prop
1012	      (let ((to (or (next-single-property-change pos 'display)
1013			    (point-max))))
1014		(if (< to (+ pos 4))
1015		    (setq under-display "")
1016		  (setq under-display "..."
1017			to (+ pos 4)))
1018		(setq under-display
1019		      (concat (buffer-substring-no-properties pos to)
1020			      under-display)))
1021	    (setq encoded (and (>= char 128) (encode-coding-char char coding))))
1022	  (setq encoding-msg
1023		(if display-prop
1024		    (if (not (stringp display-prop))
1025			(format "(%d, #o%o, #x%x, part of display \"%s\")"
1026				char char char under-display)
1027		      (format "(%d, #o%o, #x%x, part of display \"%s\"->\"%s\")"
1028			      char char char under-display display-prop))
1029		  (if encoded
1030		      (format "(%d, #o%o, #x%x, file %s)"
1031			      char char char
1032			      (if (> (length encoded) 1)
1033				  "..."
1034				(encoded-string-description encoded coding)))
1035		    (format "(%d, #o%o, #x%x)" char char char)))))
1036	(if detail
1037	    ;; We show the detailed information about CHAR.
1038	    (describe-char (point)))
1039	(if (or (/= beg 1) (/= end (1+ total)))
1040	    (message "Char: %s %s point=%d of %d (%d%%) <%d-%d> column=%d%s"
1041		     (if (< char 256)
1042			 (single-key-description char)
1043		       (buffer-substring-no-properties (point) (1+ (point))))
1044		     encoding-msg pos total percent beg end col hscroll)
1045	  (message "Char: %s %s point=%d of %d (%d%%) column=%d%s"
1046		   (if enable-multibyte-characters
1047		       (if (< char 128)
1048			   (single-key-description char)
1049			 (buffer-substring-no-properties (point) (1+ (point))))
1050		     (single-key-description char))
1051		   encoding-msg pos total percent col hscroll))))))
1052
1053;; Initialize read-expression-map.  It is defined at C level.
1054(let ((m (make-sparse-keymap)))
1055  (define-key m "\M-\t" 'lisp-complete-symbol)
1056  (set-keymap-parent m minibuffer-local-map)
1057  (setq read-expression-map m))
1058
1059(defvar read-expression-history nil)
1060
1061(defvar minibuffer-completing-symbol nil
1062  "Non-nil means completing a Lisp symbol in the minibuffer.")
1063
1064(defvar minibuffer-default nil
1065  "The current default value or list of default values in the minibuffer.
1066The functions `read-from-minibuffer' and `completing-read' bind
1067this variable locally.")
1068
1069(defcustom eval-expression-print-level 4
1070  "Value for `print-level' while printing value in `eval-expression'.
1071A value of nil means no limit."
1072  :group 'lisp
1073  :type '(choice (const :tag "No Limit" nil) integer)
1074  :version "21.1")
1075
1076(defcustom eval-expression-print-length 12
1077  "Value for `print-length' while printing value in `eval-expression'.
1078A value of nil means no limit."
1079  :group 'lisp
1080  :type '(choice (const :tag "No Limit" nil) integer)
1081  :version "21.1")
1082
1083(defcustom eval-expression-debug-on-error t
1084  "If non-nil set `debug-on-error' to t in `eval-expression'.
1085If nil, don't change the value of `debug-on-error'."
1086  :group 'lisp
1087  :type 'boolean
1088  :version "21.1")
1089
1090(defun eval-expression-print-format (value)
1091  "Format VALUE as a result of evaluated expression.
1092Return a formatted string which is displayed in the echo area
1093in addition to the value printed by prin1 in functions which
1094display the result of expression evaluation."
1095  (if (and (integerp value)
1096           (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
1097               (eq this-command last-command)
1098               (if (boundp 'edebug-active) edebug-active)))
1099      (let ((char-string
1100             (if (or (if (boundp 'edebug-active) edebug-active)
1101		     (memq this-command '(eval-last-sexp eval-print-last-sexp)))
1102                 (prin1-char value))))
1103        (if char-string
1104            (format " (#o%o, #x%x, %s)" value value char-string)
1105          (format " (#o%o, #x%x)" value value)))))
1106
1107;; We define this, rather than making `eval' interactive,
1108;; for the sake of completion of names like eval-region, eval-buffer.
1109(defun eval-expression (eval-expression-arg
1110			&optional eval-expression-insert-value)
1111  "Evaluate EVAL-EXPRESSION-ARG and print value in the echo area.
1112Value is also consed on to front of the variable `values'.
1113Optional argument EVAL-EXPRESSION-INSERT-VALUE, if non-nil, means
1114insert the result into the current buffer instead of printing it in
1115the echo area.  Truncates long output according to the value of the
1116variables `eval-expression-print-length' and `eval-expression-print-level'.
1117
1118If `eval-expression-debug-on-error' is non-nil, which is the default,
1119this command arranges for all errors to enter the debugger."
1120  (interactive
1121   (list (let ((minibuffer-completing-symbol t))
1122	   (read-from-minibuffer "Eval: "
1123				 nil read-expression-map t
1124				 'read-expression-history))
1125	 current-prefix-arg))
1126
1127  (if (null eval-expression-debug-on-error)
1128      (setq values (cons (eval eval-expression-arg) values))
1129    (let ((old-value (make-symbol "t")) new-value)
1130      ;; Bind debug-on-error to something unique so that we can
1131      ;; detect when evaled code changes it.
1132      (let ((debug-on-error old-value))
1133	(setq values (cons (eval eval-expression-arg) values))
1134	(setq new-value debug-on-error))
1135      ;; If evaled code has changed the value of debug-on-error,
1136      ;; propagate that change to the global binding.
1137      (unless (eq old-value new-value)
1138	(setq debug-on-error new-value))))
1139
1140  (let ((print-length eval-expression-print-length)
1141	(print-level eval-expression-print-level))
1142    (if eval-expression-insert-value
1143	(with-no-warnings
1144	 (let ((standard-output (current-buffer)))
1145	   (prin1 (car values))))
1146      (prog1
1147          (prin1 (car values) t)
1148        (let ((str (eval-expression-print-format (car values))))
1149          (if str (princ str t)))))))
1150
1151(defun edit-and-eval-command (prompt command)
1152  "Prompting with PROMPT, let user edit COMMAND and eval result.
1153COMMAND is a Lisp expression.  Let user edit that expression in
1154the minibuffer, then read and evaluate the result."
1155  (let ((command
1156	 (let ((print-level nil)
1157	       (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
1158	   (unwind-protect
1159	       (read-from-minibuffer prompt
1160				     (prin1-to-string command)
1161				     read-expression-map t
1162				     'command-history)
1163	     ;; If command was added to command-history as a string,
1164	     ;; get rid of that.  We want only evaluable expressions there.
1165	     (if (stringp (car command-history))
1166		 (setq command-history (cdr command-history)))))))
1167
1168    ;; If command to be redone does not match front of history,
1169    ;; add it to the history.
1170    (or (equal command (car command-history))
1171	(setq command-history (cons command command-history)))
1172    (eval command)))
1173
1174(defun repeat-complex-command (arg)
1175  "Edit and re-evaluate last complex command, or ARGth from last.
1176A complex command is one which used the minibuffer.
1177The command is placed in the minibuffer as a Lisp form for editing.
1178The result is executed, repeating the command as changed.
1179If the command has been changed or is not the most recent previous
1180command it is added to the front of the command history.
1181You can use the minibuffer history commands \
1182\\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
1183to get different commands to edit and resubmit."
1184  (interactive "p")
1185  (let ((elt (nth (1- arg) command-history))
1186	newcmd)
1187    (if elt
1188	(progn
1189	  (setq newcmd
1190		(let ((print-level nil)
1191		      (minibuffer-history-position arg)
1192		      (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
1193		  (unwind-protect
1194		      (read-from-minibuffer
1195		       "Redo: " (prin1-to-string elt) read-expression-map t
1196		       (cons 'command-history arg))
1197
1198		    ;; If command was added to command-history as a
1199		    ;; string, get rid of that.  We want only
1200		    ;; evaluable expressions there.
1201		    (if (stringp (car command-history))
1202			(setq command-history (cdr command-history))))))
1203
1204	  ;; If command to be redone does not match front of history,
1205	  ;; add it to the history.
1206	  (or (equal newcmd (car command-history))
1207	      (setq command-history (cons newcmd command-history)))
1208	  (eval newcmd))
1209      (if command-history
1210	  (error "Argument %d is beyond length of command history" arg)
1211	(error "There are no previous complex commands to repeat")))))
1212
1213(defvar minibuffer-history nil
1214  "Default minibuffer history list.
1215This is used for all minibuffer input
1216except when an alternate history list is specified.
1217
1218Maximum length of the history list is determined by the value
1219of `history-length', which see.")
1220(defvar minibuffer-history-sexp-flag nil
1221  "Control whether history list elements are expressions or strings.
1222If the value of this variable equals current minibuffer depth,
1223they are expressions; otherwise they are strings.
1224\(That convention is designed to do the right thing for
1225recursive uses of the minibuffer.)")
1226(setq minibuffer-history-variable 'minibuffer-history)
1227(setq minibuffer-history-position nil)  ;; Defvar is in C code.
1228(defvar minibuffer-history-search-history nil)
1229
1230(defvar minibuffer-text-before-history nil
1231  "Text that was in this minibuffer before any history commands.
1232This is nil if there have not yet been any history commands
1233in this use of the minibuffer.")
1234
1235(add-hook 'minibuffer-setup-hook 'minibuffer-history-initialize)
1236
1237(defun minibuffer-history-initialize ()
1238  (setq minibuffer-text-before-history nil))
1239
1240(defun minibuffer-avoid-prompt (new old)
1241  "A point-motion hook for the minibuffer, that moves point out of the prompt."
1242  (constrain-to-field nil (point-max)))
1243
1244(defcustom minibuffer-history-case-insensitive-variables nil
1245  "Minibuffer history variables for which matching should ignore case.
1246If a history variable is a member of this list, then the
1247\\[previous-matching-history-element] and \\[next-matching-history-element]\
1248 commands ignore case when searching it, regardless of `case-fold-search'."
1249  :type '(repeat variable)
1250  :group 'minibuffer)
1251
1252(defun previous-matching-history-element (regexp n)
1253  "Find the previous history element that matches REGEXP.
1254\(Previous history elements refer to earlier actions.)
1255With prefix argument N, search for Nth previous match.
1256If N is negative, find the next or Nth next match.
1257Normally, history elements are matched case-insensitively if
1258`case-fold-search' is non-nil, but an uppercase letter in REGEXP
1259makes the search case-sensitive.
1260See also `minibuffer-history-case-insensitive-variables'."
1261  (interactive
1262   (let* ((enable-recursive-minibuffers t)
1263	  (regexp (read-from-minibuffer "Previous element matching (regexp): "
1264					nil
1265					minibuffer-local-map
1266					nil
1267					'minibuffer-history-search-history
1268					(car minibuffer-history-search-history))))
1269     ;; Use the last regexp specified, by default, if input is empty.
1270     (list (if (string= regexp "")
1271	       (if minibuffer-history-search-history
1272		   (car minibuffer-history-search-history)
1273		 (error "No previous history search regexp"))
1274	     regexp)
1275	   (prefix-numeric-value current-prefix-arg))))
1276  (unless (zerop n)
1277    (if (and (zerop minibuffer-history-position)
1278	     (null minibuffer-text-before-history))
1279	(setq minibuffer-text-before-history
1280	      (minibuffer-contents-no-properties)))
1281    (let ((history (symbol-value minibuffer-history-variable))
1282	  (case-fold-search
1283	   (if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
1284	       ;; On some systems, ignore case for file names.
1285	       (if (memq minibuffer-history-variable
1286			 minibuffer-history-case-insensitive-variables)
1287		   t
1288		 ;; Respect the user's setting for case-fold-search:
1289		 case-fold-search)
1290	     nil))
1291	  prevpos
1292	  match-string
1293	  match-offset
1294	  (pos minibuffer-history-position))
1295      (while (/= n 0)
1296	(setq prevpos pos)
1297	(setq pos (min (max 1 (+ pos (if (< n 0) -

Large files files are truncated, but you can click here to view the full file