simple.el 200 KB
Newer Older
Eric S. Raymond's avatar
Eric S. Raymond committed
1 2
;;; simple.el --- basic editing commands for Emacs

3
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
4
;;               2000, 2001, 2002, 2003, 2004, 2005
5
;;        Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
6

Pavel Janík's avatar
Pavel Janík committed
7 8 9
;; Maintainer: FSF
;; Keywords: internal

Jim Blandy's avatar
Jim Blandy committed
10 11 12 13
;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
Eric S. Raymond's avatar
Eric S. Raymond committed
14
;; the Free Software Foundation; either version 2, or (at your option)
Jim Blandy's avatar
Jim Blandy committed
15 16 17 18 19 20 21 22
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
23 24 25
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
Jim Blandy's avatar
Jim Blandy committed
26

27 28 29 30 31
;;; Commentary:

;; A grab-bag of basic Emacs commands not specifically related to some
;; major mode or to file-handling.

Eric S. Raymond's avatar
Eric S. Raymond committed
32
;;; Code:
Jim Blandy's avatar
Jim Blandy committed
33

Gerd Moellmann's avatar
Gerd Moellmann committed
34
(eval-when-compile
35
  (autoload 'widget-convert "wid-edit")
Richard M. Stallman's avatar
Richard M. Stallman committed
36
  (autoload 'shell-mode "shell"))
Gerd Moellmann's avatar
Gerd Moellmann committed
37

38 39 40 41 42 43 44
(defcustom idle-update-delay 0.5
  "*Idle time delay before updating various things on the screen.
Various Emacs features that update auxiliary information when point moves
wait this many seconds after Emacs becomes idle before doing an update."
  :type 'number
  :group 'display
  :version "22.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
45

46
(defgroup killing nil
47
  "Killing and yanking commands."
48 49 50 51 52 53
  :group 'editing)

(defgroup paren-matching nil
  "Highlight (un)matching of parens and expressions."
  :group 'matching)

54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
(defun next-buffer ()
  "Switch to the next buffer in cyclic order."
  (interactive)
  (let ((buffer (current-buffer)))
    (switch-to-buffer (other-buffer buffer))
    (bury-buffer buffer)))

(defun prev-buffer ()
  "Switch to the previous buffer in cyclic order."
  (interactive)
  (let ((list (nreverse (buffer-list)))
	found)
    (while (and (not found) list)
      (let ((buffer (car list)))
	(if (and (not (get-buffer-window buffer))
		 (not (string-match "\\` " (buffer-name buffer))))
	    (setq found buffer)))
      (setq list (cdr list)))
    (switch-to-buffer found)))
73

74
;;; next-error support framework
75 76 77 78

(defgroup next-error nil
  "next-error support framework."
  :group 'compilation
79
  :version "22.1")
80 81 82 83 84

(defface next-error
  '((t (:inherit region)))
  "Face used to highlight next error locus."
  :group 'next-error
85
  :version "22.1")
86 87 88 89 90 91 92 93 94 95 96 97

(defcustom next-error-highlight 0.1
  "*Highlighting of locations in selected source buffers.
If number, highlight the locus in next-error face for given time in seconds.
If t, use persistent overlays fontified in next-error face.
If nil, don't highlight the locus in the source buffer.
If `fringe-arrow', indicate the locus by the fringe arrow."
  :type '(choice (number :tag "Delay")
                 (const :tag "Persistent overlay" t)
                 (const :tag "No highlighting" nil)
                 (const :tag "Fringe arrow" 'fringe-arrow))
  :group 'next-error
98
  :version "22.1")
99 100 101 102 103 104 105 106 107 108 109 110

(defcustom next-error-highlight-no-select 0.1
  "*Highlighting of locations in non-selected source buffers.
If number, highlight the locus in next-error face for given time in seconds.
If t, use persistent overlays fontified in next-error face.
If nil, don't highlight the locus in the source buffer.
If `fringe-arrow', indicate the locus by the fringe arrow."
  :type '(choice (number :tag "Delay")
                 (const :tag "Persistent overlay" t)
                 (const :tag "No highlighting" nil)
                 (const :tag "Fringe arrow" 'fringe-arrow))
  :group 'next-error
111
  :version "22.1")
112

113 114
(defvar next-error-highlight-timer nil)

115
(defvar next-error-overlay-arrow-position nil)
116 117 118
;; This is nil so as not to really display anything on text
;; terminals.  On text terminals, it would hide part of the file name.
(put 'next-error-overlay-arrow-position 'overlay-arrow-string "")
119 120
(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)

121 122 123 124 125 126 127
(defvar next-error-last-buffer nil
  "The most recent next-error buffer.
A buffer becomes most recent when its compilation, grep, or
similar mode is started, or when it is used with \\[next-error]
or \\[compile-goto-error].")

(defvar next-error-function nil
128 129 130 131 132 133 134 135
  "Function to use to find the next error in the current buffer.
The function is called with 2 parameters:
ARG is an integer specifying by how many errors to move.
RESET is a boolean which, if non-nil, says to go back to the beginning
of the errors before moving.
Major modes providing compile-like functionality should set this variable
to indicate to `next-error' that this is a candidate buffer and how
to navigate in it.")
136 137 138

(make-variable-buffer-local 'next-error-function)

139
(defsubst next-error-buffer-p (buffer
140
			       &optional avoid-current
141
			       extra-test-inclusive
142 143
			       extra-test-exclusive)
  "Test if BUFFER is a next-error capable buffer.
144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167

If AVOID-CURRENT is non-nil, treat the current buffer
as an absolute last resort only.

The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
that normally would not qualify.  If it returns t, the buffer
in question is treated as usable.

The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer
that would normally be considered usable.  if it returns nil,
that buffer is rejected."
  (and (buffer-name buffer)		;First make sure it's live.
       (not (and avoid-current (eq buffer (current-buffer))))
       (with-current-buffer buffer
	 (if next-error-function   ; This is the normal test.
	     ;; Optionally reject some buffers.
	     (if extra-test-exclusive
		 (funcall extra-test-exclusive)
	       t)
	   ;; Optionally accept some other buffers.
	   (and extra-test-inclusive
		(funcall extra-test-inclusive))))))

(defun next-error-find-buffer (&optional avoid-current
168
					 extra-test-inclusive
169 170
					 extra-test-exclusive)
  "Return a next-error capable buffer.
171 172 173 174 175 176 177 178 179 180
If AVOID-CURRENT is non-nil, treat the current buffer
as an absolute last resort only.

The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffers
that normally would not qualify.  If it returns t, the buffer
in question is treated as usable.

The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer
that would normally be considered usable.  If it returns nil,
that buffer is rejected."
181 182 183 184 185 186
  (or
   ;; 1. If one window on the selected frame displays such buffer, return it.
   (let ((window-buffers
          (delete-dups
           (delq nil (mapcar (lambda (w)
                               (if (next-error-buffer-p
187 188
				    (window-buffer w)
                                    avoid-current
189
                                    extra-test-inclusive extra-test-exclusive)
190 191 192 193
                                   (window-buffer w)))
                             (window-list))))))
     (if (eq (length window-buffers) 1)
         (car window-buffers)))
194
   ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
195
   (if (and next-error-last-buffer
196
            (next-error-buffer-p next-error-last-buffer avoid-current
197
                                 extra-test-inclusive extra-test-exclusive))
198 199 200 201
       next-error-last-buffer)
   ;; 3. If the current buffer is acceptable, choose it.
   (if (next-error-buffer-p (current-buffer) avoid-current
			    extra-test-inclusive extra-test-exclusive)
202
       (current-buffer))
203
   ;; 4. Look for any acceptable buffer.
204 205
   (let ((buffers (buffer-list)))
     (while (and buffers
206 207 208
                 (not (next-error-buffer-p
		       (car buffers) avoid-current
		       extra-test-inclusive extra-test-exclusive)))
209
       (setq buffers (cdr buffers)))
210 211 212 213 214 215 216 217 218 219 220
     (car buffers))
   ;; 5. Use the current buffer as a last resort if it qualifies,
   ;; even despite AVOID-CURRENT.
   (and avoid-current
	(next-error-buffer-p (current-buffer) nil
			     extra-test-inclusive extra-test-exclusive)
	(progn
	  (message "This is the only next-error capable buffer")
	  (current-buffer)))
   ;; 6. Give up.
   (error "No next-error capable buffer found")))
221

222
(defun next-error (&optional arg reset)
223 224 225 226 227
  "Visit next next-error message and corresponding source code.

If all the error messages parsed so far have been processed already,
the message buffer is checked for new ones.

228
A prefix ARG specifies how many error messages to move;
229 230 231 232
negative means move back to previous error messages.
Just \\[universal-argument] as a prefix means reparse the error message buffer
and start at the first error.

233
The RESET argument specifies that we should restart from the beginning.
234 235 236 237 238 239

\\[next-error] normally uses the most recently started
compilation, grep, or occur buffer.  It can also operate on any
buffer with output from the \\[compile], \\[grep] commands, or,
more generally, on any buffer in Compilation mode or with
Compilation Minor mode enabled, or any buffer in which
240 241 242 243
`next-error-function' is bound to an appropriate function.
To specify use of a particular buffer for error messages, type
\\[next-error] in that buffer when it is the only one displayed
in the current frame.
244 245 246 247 248 249 250 251

Once \\[next-error] has chosen the buffer for error messages,
it stays with that buffer until you use it in some other buffer which
uses Compilation mode or Compilation Minor mode.

See variables `compilation-parse-errors-function' and
\`compilation-error-regexp-alist' for customization ideas."
  (interactive "P")
252
  (if (consp arg) (setq reset t arg nil))
253 254 255
  (when (setq next-error-last-buffer (next-error-find-buffer))
    ;; we know here that next-error-function is a valid symbol we can funcall
    (with-current-buffer next-error-last-buffer
256
      (funcall next-error-function (prefix-numeric-value arg) reset))))
257 258 259 260

(defalias 'goto-next-locus 'next-error)
(defalias 'next-match 'next-error)

261
(defun previous-error (&optional n)
262 263 264 265 266 267 268
  "Visit previous next-error message and corresponding source code.

Prefix arg N says how many error messages to move backwards (or
forwards, if negative).

This operates on the output from the \\[compile] and \\[grep] commands."
  (interactive "p")
269
  (next-error (- (or n 1))))
270

271
(defun first-error (&optional n)
272 273 274 275 276 277 278
  "Restart at the first error.
Visit corresponding source code.
With prefix arg N, visit the source code of the Nth error.
This operates on the output from the \\[compile] command, for instance."
  (interactive "p")
  (next-error n t))

279
(defun next-error-no-select (&optional n)
280 281 282 283 284 285
  "Move point to the next error in the next-error buffer and highlight match.
Prefix arg N says how many error messages to move forwards (or
backwards, if negative).
Finds and highlights the source line like \\[next-error], but does not
select the source buffer."
  (interactive "p")
286 287
  (let ((next-error-highlight next-error-highlight-no-select))
    (next-error n))
288 289
  (pop-to-buffer next-error-last-buffer))

290
(defun previous-error-no-select (&optional n)
291 292 293 294 295 296
  "Move point to the previous error in the next-error buffer and highlight match.
Prefix arg N says how many error messages to move backwards (or
forwards, if negative).
Finds and highlights the source line like \\[previous-error], but does not
select the source buffer."
  (interactive "p")
297
  (next-error-no-select (- (or n 1))))
298

299 300 301
;;; Internal variable for `next-error-follow-mode-post-command-hook'.
(defvar next-error-follow-last-line nil)

Eli Zaretskii's avatar
Eli Zaretskii committed
302
(define-minor-mode next-error-follow-minor-mode
303
  "Minor mode for compilation, occur and diff modes.
Eli Zaretskii's avatar
Eli Zaretskii committed
304 305 306
When turned on, cursor motion in the compilation, grep, occur or diff
buffer causes automatic display of the corresponding source code
location."
307
  :group 'next-error :init-value " Fol"
308
  (if (not next-error-follow-minor-mode)
309 310 311 312 313 314 315 316 317 318 319 320 321 322 323
      (remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t)
    (add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t)
    (make-variable-buffer-local 'next-error-follow-last-line)))

;;; Used as a `post-command-hook' by `next-error-follow-mode'
;;; for the *Compilation* *grep* and *Occur* buffers.
(defun next-error-follow-mode-post-command-hook ()
  (unless (equal next-error-follow-last-line (line-number-at-pos))
    (setq next-error-follow-last-line (line-number-at-pos))
    (condition-case nil
	(let ((compilation-context-lines nil))
	  (setq compilation-current-error (point))
	  (next-error-no-select 0))
      (error t))))

324

325 326
;;;

Karl Heuer's avatar
Karl Heuer committed
327 328 329 330
(defun fundamental-mode ()
  "Major mode not specialized for anything in particular.
Other major modes are defined by comparison with this one."
  (interactive)
331 332
  (kill-all-local-variables)
  (run-hooks 'after-change-major-mode-hook))
333

Karl Heuer's avatar
Karl Heuer committed
334 335
;; Making and deleting lines.

336
(defun newline (&optional arg)
337
  "Insert a newline, and move to left margin of the new line if it's blank.
Dave Love's avatar
Dave Love committed
338 339
If `use-hard-newlines' is non-nil, the newline is marked with the
text-property `hard'.
340
With ARG, insert that many newlines.
Dave Love's avatar
Dave Love committed
341
Call `auto-fill-function' if the current column number is greater
342
than the value of `fill-column' and ARG is nil."
343
  (interactive "*P")
344
  (barf-if-buffer-read-only)
345 346 347 348
  ;; Inserting a newline at the end of a line produces better redisplay in
  ;; try_window_id than inserting at the beginning of a line, and the textual
  ;; result is the same.  So, if we're at beginning of line, pretend to be at
  ;; the end of the previous line.
349
  (let ((flag (and (not (bobp))
350
		   (bolp)
351 352 353 354
		   ;; Make sure no functions want to be told about
		   ;; the range of the changes.
		   (not after-change-functions)
		   (not before-change-functions)
355 356
		   ;; Make sure there are no markers here.
		   (not (buffer-has-markers-at (1- (point))))
357
		   (not (buffer-has-markers-at (point)))
358 359 360 361 362 363
		   ;; Make sure no text properties want to know
		   ;; where the change was.
		   (not (get-char-property (1- (point)) 'modification-hooks))
		   (not (get-char-property (1- (point)) 'insert-behind-hooks))
		   (or (eobp)
		       (not (get-char-property (point) 'insert-in-front-hooks)))
364 365 366 367 368 369 370 371
		   ;; Make sure the newline before point isn't intangible.
		   (not (get-char-property (1- (point)) 'intangible))
		   ;; Make sure the newline before point isn't read-only.
		   (not (get-char-property (1- (point)) 'read-only))
		   ;; Make sure the newline before point isn't invisible.
		   (not (get-char-property (1- (point)) 'invisible))
		   ;; Make sure the newline before point has the same
		   ;; properties as the char before it (if any).
372
		   (< (or (previous-property-change (point)) -2)
373 374 375 376
		      (- (point) 2))))
	(was-page-start (and (bolp)
			     (looking-at page-delimiter)))
	(beforepos (point)))
377 378 379 380 381
    (if flag (backward-char 1))
    ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
    ;; Set last-command-char to tell self-insert what to insert.
    (let ((last-command-char ?\n)
	  ;; Don't auto-fill if we have a numeric argument.
382 383 384
	  ;; Also not if flag is true (it would fill wrong line);
	  ;; there is no need to since we're at BOL.
	  (auto-fill-function (if (or arg flag) nil auto-fill-function)))
385 386 387 388
      (unwind-protect
	  (self-insert-command (prefix-numeric-value arg))
	;; If we get an error in self-insert-command, put point at right place.
	(if flag (forward-char 1))))
389 390 391 392
    ;; Even if we did *not* get an error, keep that forward-char;
    ;; all further processing should apply to the newline that the user
    ;; thinks he inserted.

393 394
    ;; Mark the newline(s) `hard'.
    (if use-hard-newlines
395
	(set-hard-newline-properties
396
	 (- (point) (if arg (prefix-numeric-value arg) 1)) (point)))
397 398 399 400 401 402 403 404 405 406 407 408 409 410
    ;; If the newline leaves the previous line blank,
    ;; and we have a left margin, delete that from the blank line.
    (or flag
	(save-excursion
	  (goto-char beforepos)
	  (beginning-of-line)
	  (and (looking-at "[ \t]$")
	       (> (current-left-margin) 0)
	       (delete-region (point) (progn (end-of-line) (point))))))
    ;; Indent the line after the newline, except in one case:
    ;; when we added the newline at the beginning of a line
    ;; which starts a page.
    (or was-page-start
	(move-to-left-margin nil t)))
411 412
  nil)

413 414 415 416 417 418 419
(defun set-hard-newline-properties (from to)
  (let ((sticky (get-text-property from 'rear-nonsticky)))
    (put-text-property from to 'hard 't)
    ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
    (if (and (listp sticky) (not (memq 'hard sticky)))
	(put-text-property from (point) 'rear-nonsticky
			   (cons 'hard sticky)))))
420

421
(defun open-line (n)
422
  "Insert a newline and leave point before it.
423
If there is a fill prefix and/or a left-margin, insert them on the new line
424
if the line would have been blank.
425
With arg N, insert N newlines."
Jim Blandy's avatar
Jim Blandy committed
426
  (interactive "*p")
427
  (let* ((do-fill-prefix (and fill-prefix (bolp)))
428
	 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
429 430 431
	 (loc (point))
	 ;; Don't expand an abbrev before point.
	 (abbrev-mode nil))
432
    (newline n)
433
    (goto-char loc)
434
    (while (> n 0)
435 436 437 438
      (cond ((bolp)
	     (if do-left-margin (indent-to (current-left-margin)))
	     (if do-fill-prefix (insert-and-inherit fill-prefix))))
      (forward-line 1)
439
      (setq n (1- n)))
440 441
    (goto-char loc)
    (end-of-line)))
Jim Blandy's avatar
Jim Blandy committed
442

443 444 445
(defun split-line (&optional arg)
  "Split current line, moving portion beyond point vertically down.
If the current line starts with `fill-prefix', insert it on the new
446
line as well.  With prefix ARG, don't insert fill-prefix on new line.
447

448
When called from Lisp code, ARG may be a prefix string to copy."
449
  (interactive "*P")
Jim Blandy's avatar
Jim Blandy committed
450
  (skip-chars-forward " \t")
451 452 453 454 455 456 457 458 459 460 461
  (let* ((col (current-column))
	 (pos (point))
	 ;; What prefix should we check for (nil means don't).
	 (prefix (cond ((stringp arg) arg)
		       (arg nil)
		       (t fill-prefix)))
	 ;; Does this line start with it?
	 (have-prfx (and prefix
			 (save-excursion
			   (beginning-of-line)
			   (looking-at (regexp-quote prefix))))))
462
    (newline 1)
463
    (if have-prfx (insert-and-inherit prefix))
Jim Blandy's avatar
Jim Blandy committed
464 465 466 467 468
    (indent-to col 0)
    (goto-char pos)))

(defun delete-indentation (&optional arg)
  "Join this line to previous and fix up whitespace at join.
469
If there is a fill prefix, delete it from the beginning of this line.
Jim Blandy's avatar
Jim Blandy committed
470 471 472 473 474 475 476
With argument, join this line to following line."
  (interactive "*P")
  (beginning-of-line)
  (if arg (forward-line 1))
  (if (eq (preceding-char) ?\n)
      (progn
	(delete-region (point) (1- (point)))
477 478 479
	;; If the second line started with the fill prefix,
	;; delete the prefix.
	(if (and fill-prefix
480
		 (<= (+ (point) (length fill-prefix)) (point-max))
481 482 483 484
		 (string= fill-prefix
			  (buffer-substring (point)
					    (+ (point) (length fill-prefix)))))
	    (delete-region (point) (+ (point) (length fill-prefix))))
Jim Blandy's avatar
Jim Blandy committed
485 486
	(fixup-whitespace))))

Dave Love's avatar
Dave Love committed
487
(defalias 'join-line #'delete-indentation) ; easier to find
488

Jim Blandy's avatar
Jim Blandy committed
489 490 491
(defun delete-blank-lines ()
  "On blank line, delete all surrounding blank lines, leaving just one.
On isolated blank line, delete that one.
492
On nonblank line, delete any immediately following blank lines."
Jim Blandy's avatar
Jim Blandy committed
493 494 495 496 497
  (interactive "*")
  (let (thisblank singleblank)
    (save-excursion
      (beginning-of-line)
      (setq thisblank (looking-at "[ \t]*$"))
Jim Blandy's avatar
Jim Blandy committed
498
      ;; Set singleblank if there is just one blank line here.
Jim Blandy's avatar
Jim Blandy committed
499 500 501 502 503 504
      (setq singleblank
	    (and thisblank
		 (not (looking-at "[ \t]*\n[ \t]*$"))
		 (or (bobp)
		     (progn (forward-line -1)
			    (not (looking-at "[ \t]*$")))))))
Jim Blandy's avatar
Jim Blandy committed
505
    ;; Delete preceding blank lines, and this one too if it's the only one.
Jim Blandy's avatar
Jim Blandy committed
506 507 508 509 510 511 512 513
    (if thisblank
	(progn
	  (beginning-of-line)
	  (if singleblank (forward-line 1))
	  (delete-region (point)
			 (if (re-search-backward "[^ \t\n]" nil t)
			     (progn (forward-line 1) (point))
			   (point-min)))))
Jim Blandy's avatar
Jim Blandy committed
514 515
    ;; Delete following blank lines, unless the current line is blank
    ;; and there are no following blank lines.
Jim Blandy's avatar
Jim Blandy committed
516 517 518 519 520 521 522
    (if (not (and thisblank singleblank))
	(save-excursion
	  (end-of-line)
	  (forward-line 1)
	  (delete-region (point)
			 (if (re-search-forward "[^ \t\n]" nil t)
			     (progn (beginning-of-line) (point))
Jim Blandy's avatar
Jim Blandy committed
523 524 525 526 527
			   (point-max)))))
    ;; Handle the special case where point is followed by newline and eob.
    ;; Delete the line, leaving point at eob.
    (if (looking-at "^[ \t]*\n\\'")
	(delete-region (point) (point-max)))))
Jim Blandy's avatar
Jim Blandy committed
528

529 530 531
(defun delete-trailing-whitespace ()
  "Delete all the trailing whitespace across the current buffer.
All whitespace after the last non-whitespace character in a line is deleted.
532 533
This respects narrowing, created by \\[narrow-to-region] and friends.
A formfeed is not considered whitespace by this function."
534 535 536 537
  (interactive "*")
  (save-match-data
    (save-excursion
      (goto-char (point-min))
538 539
      (while (re-search-forward "\\s-$" nil t)
	(skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
540
	;; Don't delete formfeeds, even if they are considered whitespace.
541 542 543
	(save-match-data
	  (if (looking-at ".*\f")
	      (goto-char (match-end 0))))
544
	(delete-region (point) (match-end 0))))))
545

Jim Blandy's avatar
Jim Blandy committed
546 547
(defun newline-and-indent ()
  "Insert a newline, then indent according to major mode.
548
Indentation is done using the value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
549
In programming language modes, this is the same as TAB.
550
In some text modes, where TAB inserts a tab, this command indents to the
551
column specified by the function `current-left-margin'."
Jim Blandy's avatar
Jim Blandy committed
552
  (interactive "*")
553
  (delete-horizontal-space t)
Jim Blandy's avatar
Jim Blandy committed
554
  (newline)
Jim Blandy's avatar
Jim Blandy committed
555 556 557 558 559
  (indent-according-to-mode))

(defun reindent-then-newline-and-indent ()
  "Reindent current line, insert newline, then indent the new line.
Indentation of both lines is done according to the current major mode,
560
which means calling the current value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
561 562
In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this indents to the
563
column specified by the function `current-left-margin'."
Jim Blandy's avatar
Jim Blandy committed
564
  (interactive "*")
565 566 567 568 569 570
  (let ((pos (point)))
    ;; Be careful to insert the newline before indenting the line.
    ;; Otherwise, the indentation might be wrong.
    (newline)
    (save-excursion
      (goto-char pos)
571 572
      (indent-according-to-mode)
      (delete-horizontal-space t))
573
    (indent-according-to-mode)))
574

Karl Heuer's avatar
Karl Heuer committed
575 576 577
(defun quoted-insert (arg)
  "Read next input character and insert it.
This is useful for inserting control characters.
Jim Blandy's avatar
Jim Blandy committed
578

Karl Heuer's avatar
Karl Heuer committed
579 580 581 582 583 584
If the first character you type after this command is an octal digit,
you should type a sequence of octal digits which specify a character code.
Any nondigit terminates the sequence.  If the terminator is a RET,
it is discarded; any other terminator is used itself as input.
The variable `read-quoted-char-radix' specifies the radix for this feature;
set it to 10 or 16 to use decimal or hex instead of octal.
585

Karl Heuer's avatar
Karl Heuer committed
586 587 588 589
In overwrite mode, this function inserts the character anyway, and
does not handle octal digits specially.  This means that if you use
overwrite as your normal editing mode, you can use this function to
insert characters when necessary.
590

Karl Heuer's avatar
Karl Heuer committed
591 592 593 594
In binary overwrite mode, this function does overwrite, and octal
digits are interpreted as a character code.  This is intended to be
useful for editing binary files."
  (interactive "*p")
595
  (let* ((char (let (translation-table-for-input)
596 597 598 599
		 (if (or (not overwrite-mode)
			 (eq overwrite-mode 'overwrite-mode-binary))
		     (read-quoted-char)
		   (read-char)))))
Karl Heuer's avatar
Karl Heuer committed
600 601 602 603 604 605 606 607 608 609 610 611 612
    ;; Assume character codes 0240 - 0377 stand for characters in some
    ;; single-byte character set, and convert them to Emacs
    ;; characters.
    (if (and enable-multibyte-characters
	     (>= char ?\240)
	     (<= char ?\377))
	(setq char (unibyte-char-to-multibyte char)))
    (if (> arg 0)
	(if (eq overwrite-mode 'overwrite-mode-binary)
	    (delete-char arg)))
    (while (> arg 0)
      (insert-and-inherit char)
      (setq arg (1- arg)))))
613

614
(defun forward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
615 616
  "Move forward ARG lines and position at first nonblank character."
  (interactive "p")
617
  (forward-line (or arg 1))
Karl Heuer's avatar
Karl Heuer committed
618
  (skip-chars-forward " \t"))
619

620
(defun backward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
621 622
  "Move backward ARG lines and position at first nonblank character."
  (interactive "p")
623
  (forward-line (- (or arg 1)))
Karl Heuer's avatar
Karl Heuer committed
624
  (skip-chars-forward " \t"))
Jim Blandy's avatar
Jim Blandy committed
625

Karl Heuer's avatar
Karl Heuer committed
626 627 628 629
(defun back-to-indentation ()
  "Move point to the first non-whitespace character on this line."
  (interactive)
  (beginning-of-line 1)
630
  (skip-syntax-forward " " (line-end-position))
631 632
  ;; Move back over chars that have whitespace syntax but have the p flag.
  (backward-prefix-chars))
Karl Heuer's avatar
Karl Heuer committed
633 634 635 636 637 638 639 640 641 642 643 644 645

(defun fixup-whitespace ()
  "Fixup white space between objects around point.
Leave one space or none, according to the context."
  (interactive "*")
  (save-excursion
    (delete-horizontal-space)
    (if (or (looking-at "^\\|\\s)")
	    (save-excursion (forward-char -1)
			    (looking-at "$\\|\\s(\\|\\s'")))
	nil
      (insert ?\ ))))

646 647 648
(defun delete-horizontal-space (&optional backward-only)
  "Delete all spaces and tabs around point.
If BACKWARD-ONLY is non-nil, only delete spaces before point."
Karl Heuer's avatar
Karl Heuer committed
649
  (interactive "*")
650 651 652 653 654 655 656
  (let ((orig-pos (point)))
    (delete-region
     (if backward-only
	 orig-pos
       (progn
	 (skip-chars-forward " \t")
	 (constrain-to-field nil orig-pos t)))
657
     (progn
658 659
       (skip-chars-backward " \t")
       (constrain-to-field nil orig-pos)))))
Karl Heuer's avatar
Karl Heuer committed
660

661
(defun just-one-space (&optional n)
662 663
  "Delete all spaces and tabs around point, leaving one space (or N spaces)."
  (interactive "*p")
664 665 666
  (let ((orig-pos (point)))
    (skip-chars-backward " \t")
    (constrain-to-field nil orig-pos)
667
    (dotimes (i (or n 1))
668 669 670
      (if (= (following-char) ?\ )
	  (forward-char 1)
	(insert ?\ )))
671 672 673 674 675
    (delete-region
     (point)
     (progn
       (skip-chars-forward " \t")
       (constrain-to-field nil orig-pos t)))))
676

Jim Blandy's avatar
Jim Blandy committed
677 678
(defun beginning-of-buffer (&optional arg)
  "Move point to the beginning of the buffer; leave mark at previous position.
679 680
With \\[universal-argument] prefix, do not set mark at previous position.
With numeric arg N, put point N/10 of the way from the beginning.
681 682 683

If the buffer is narrowed, this command uses the beginning and size
of the accessible part of the buffer.
684 685

Don't use this command in Lisp programs!
Jim Blandy's avatar
Jim Blandy committed
686 687
\(goto-char (point-min)) is faster and avoids clobbering the mark."
  (interactive "P")
688
  (or (consp arg)
689 690
      (and transient-mark-mode mark-active)
      (push-mark))
691
  (let ((size (- (point-max) (point-min))))
692
    (goto-char (if (and arg (not (consp arg)))
693 694 695 696 697 698 699
		   (+ (point-min)
		      (if (> size 10000)
			  ;; Avoid overflow for large buffer sizes!
			  (* (prefix-numeric-value arg)
			     (/ size 10))
			(/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
		 (point-min))))
Jim Blandy's avatar
Jim Blandy committed
700 701 702 703
  (if arg (forward-line 1)))

(defun end-of-buffer (&optional arg)
  "Move point to the end of the buffer; leave mark at previous position.
704 705
With \\[universal-argument] prefix, do not set mark at previous position.
With numeric arg N, put point N/10 of the way from the end.
706 707 708

If the buffer is narrowed, this command uses the beginning and size
of the accessible part of the buffer.
709 710

Don't use this command in Lisp programs!
Jim Blandy's avatar
Jim Blandy committed
711 712
\(goto-char (point-max)) is faster and avoids clobbering the mark."
  (interactive "P")
713
  (or (consp arg)
714 715
      (and transient-mark-mode mark-active)
      (push-mark))
716
  (let ((size (- (point-max) (point-min))))
717
    (goto-char (if (and arg (not (consp arg)))
718 719 720 721 722 723 724
		   (- (point-max)
		      (if (> size 10000)
			  ;; Avoid overflow for large buffer sizes!
			  (* (prefix-numeric-value arg)
			     (/ size 10))
			(/ (* size (prefix-numeric-value arg)) 10)))
		 (point-max))))
Eric S. Raymond's avatar
Eric S. Raymond committed
725 726
  ;; If we went to a place in the middle of the buffer,
  ;; adjust it to the beginning of a line.
727
  (cond (arg (forward-line 1))
728
	((> (point) (window-end nil t))
729 730 731 732
	 ;; If the end of the buffer is not already on the screen,
	 ;; then scroll specially to put it near, but not at, the bottom.
	 (overlay-recenter (point))
	 (recenter -3))))
Jim Blandy's avatar
Jim Blandy committed
733 734

(defun mark-whole-buffer ()
Jim Blandy's avatar
Jim Blandy committed
735 736 737 738
  "Put point at beginning and mark at end of buffer.
You probably should not use this function in Lisp programs;
it is usually a mistake for a Lisp function to use any subroutine
that uses or sets the mark."
Jim Blandy's avatar
Jim Blandy committed
739 740
  (interactive)
  (push-mark (point))
741
  (push-mark (point-max) nil t)
Jim Blandy's avatar
Jim Blandy committed
742
  (goto-char (point-min)))
743

744

Karl Heuer's avatar
Karl Heuer committed
745 746
;; Counting lines, one way or another.

747 748
(defun goto-line (arg &optional buffer)
  "Goto line ARG, counting from line 1 at beginning of buffer.
Eli Zaretskii's avatar
Eli Zaretskii committed
749 750 751 752
Normally, move point in the current buffer.
With just \\[universal-argument] as argument, move point in the most recently
displayed other buffer, and switch to it.  When called from Lisp code,
the optional argument BUFFER specifies a buffer to switch to.
753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789

If there's a number in the buffer at point, it is the default for ARG."
  (interactive
   (if (and current-prefix-arg (not (consp current-prefix-arg)))
       (list (prefix-numeric-value current-prefix-arg))
     ;; Look for a default, a number in the buffer at point.
     (let* ((default
	      (save-excursion
		(skip-chars-backward "0-9")
		(if (looking-at "[0-9]")
		    (buffer-substring-no-properties
		     (point)
		     (progn (skip-chars-forward "0-9")
			    (point))))))
	    ;; Decide if we're switching buffers.
	    (buffer
	     (if (consp current-prefix-arg)
		 (other-buffer (current-buffer) t)))
	    (buffer-prompt
	     (if buffer
		 (concat " in " (buffer-name buffer))
	       "")))
       ;; Read the argument, offering that number (if any) as default.
       (list (read-from-minibuffer (format (if default "Goto line%s (%s): "
					     "Goto line%s: ")
					   buffer-prompt
					   default)
				   nil nil t
				   'minibuffer-history
				   default)
	     buffer))))
  ;; Switch to the desired buffer, one way or another.
  (if buffer
      (let ((window (get-buffer-window buffer)))
	(if window (select-window window)
	  (switch-to-buffer-other-window buffer))))
  ;; Move to the specified line number in that buffer.
Karl Heuer's avatar
Karl Heuer committed
790 791 792 793 794
  (save-restriction
    (widen)
    (goto-char 1)
    (if (eq selective-display t)
	(re-search-forward "[\n\C-m]" nil 'end (1- arg))
795
      (forward-line (1- arg)))))
Jim Blandy's avatar
Jim Blandy committed
796 797

(defun count-lines-region (start end)
798
  "Print number of lines and characters in the region."
Jim Blandy's avatar
Jim Blandy committed
799 800 801 802 803
  (interactive "r")
  (message "Region has %d lines, %d characters"
	   (count-lines start end) (- end start)))

(defun what-line ()
804
  "Print the current buffer line number and narrowed line number of point."
Jim Blandy's avatar
Jim Blandy committed
805
  (interactive)
806
  (let ((start (point-min))
807
	(n (line-number-at-pos)))
Kim F. Storm's avatar
Kim F. Storm committed
808 809 810 811 812
    (if (= start 1)
	(message "Line %d" n)
      (save-excursion
	(save-restriction
	  (widen)
Luc Teirlinck's avatar
Luc Teirlinck committed
813
	  (message "line %d (narrowed line %d)"
814
		   (+ n (line-number-at-pos start) -1) n))))))
815

Jim Blandy's avatar
Jim Blandy committed
816 817 818
(defun count-lines (start end)
  "Return number of lines between START and END.
This is usually the number of newlines between them,
819
but can be one more if START is not equal to END
Jim Blandy's avatar
Jim Blandy committed
820
and the greater of them is not at the start of a line."
821 822 823 824 825 826
  (save-excursion
    (save-restriction
      (narrow-to-region start end)
      (goto-char (point-min))
      (if (eq selective-display t)
	  (save-match-data
827 828 829 830 831
	    (let ((done 0))
	      (while (re-search-forward "[\n\C-m]" nil t 40)
		(setq done (+ 40 done)))
	      (while (re-search-forward "[\n\C-m]" nil t 1)
		(setq done (+ 1 done)))
832 833 834 835
	      (goto-char (point-max))
	      (if (and (/= start end)
		       (not (bolp)))
		  (1+ done)
836 837
		done)))
	(- (buffer-size) (forward-line (buffer-size)))))))
838

839
(defun line-number-at-pos (&optional pos)
Kim F. Storm's avatar
Kim F. Storm committed
840 841 842 843 844 845 846 847 848 849
  "Return (narrowed) buffer line number at position POS.
If POS is nil, use current buffer location."
  (let ((opoint (or pos (point))) start)
    (save-excursion
      (goto-char (point-min))
      (setq start (point))
      (goto-char opoint)
      (forward-line 0)
      (1+ (count-lines start (point))))))

850 851
(defun what-cursor-position (&optional detail)
  "Print info on cursor position (on screen and within buffer).
852
Also describe the character after point, and give its character code
853 854 855 856 857 858 859
in octal, decimal and hex.

For a non-ASCII multibyte character, also give its encoding in the
buffer's selected coding system if the coding system encodes the
character safely.  If the character is encoded into one byte, that
code is shown in hex.  If the character is encoded into more than one
byte, just \"...\" is shown.
860

861
In addition, with prefix argument, show details about that character
862
in *Help* buffer.  See also the command `describe-char'."
863
  (interactive "P")
Jim Blandy's avatar
Jim Blandy committed
864 865 866 867 868 869 870 871 872 873 874 875 876 877 878
  (let* ((char (following-char))
	 (beg (point-min))
	 (end (point-max))
         (pos (point))
	 (total (buffer-size))
	 (percent (if (> total 50000)
		      ;; Avoid overflow from multiplying by 100!
		      (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
		    (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
	 (hscroll (if (= (window-hscroll) 0)
		      ""
		    (format " Hscroll=%d" (window-hscroll))))
	 (col (current-column)))
    (if (= pos end)
	(if (or (/= beg 1) (/= end (1+ total)))
879
	    (message "point=%d of %d (%d%%) <%d - %d> column %d %s"
Jim Blandy's avatar
Jim Blandy committed
880
		     pos total percent beg end col hscroll)
881
	  (message "point=%d of %d (%d%%) column %d %s"
Jim Blandy's avatar
Jim Blandy committed
882
		   pos total percent col hscroll))
883 884 885 886 887
      (let ((coding buffer-file-coding-system)
	    encoded encoding-msg)
	(if (or (not coding)
		(eq (coding-system-type coding) t))
	    (setq coding default-buffer-file-coding-system))
888 889 890 891 892 893
	(if (not (char-valid-p char))
	    (setq encoding-msg
		  (format "(0%o, %d, 0x%x, invalid)" char char char))
	  (setq encoded (and (>= char 128) (encode-coding-char char coding)))
	  (setq encoding-msg
		(if encoded
894
		    (format "(0%o, %d, 0x%x, file %s)"
895
			    char char char
896
			    (if (> (length encoded) 1)
897
				"..."
898
			      (encoded-string-description encoded coding)))
899
		  (format "(0%o, %d, 0x%x)" char char char))))
900
	(if detail
901
	    ;; We show the detailed information about CHAR.
902
	    (describe-char (point)))
903 904
	(if (or (/= beg 1) (/= end (1+ total)))
	    (message "Char: %s %s point=%d of %d (%d%%) <%d - %d> column %d %s"
905 906
		     (if (< char 256)
			 (single-key-description char)
907
		       (buffer-substring-no-properties (point) (1+ (point))))
908 909 910 911 912 913
		     encoding-msg pos total percent beg end col hscroll)
	  (message "Char: %s %s point=%d of %d (%d%%) column %d %s"
		   (if (< char 256)
		       (single-key-description char)
		     (buffer-substring-no-properties (point) (1+ (point))))
		   encoding-msg pos total percent col hscroll))))))
914

915 916 917 918 919
(defvar read-expression-map
  (let ((m (make-sparse-keymap)))
    (define-key m "\M-\t" 'lisp-complete-symbol)
    (set-keymap-parent m minibuffer-local-map)
    m)
920 921
  "Minibuffer keymap used for reading Lisp expressions.")

922 923
(defvar read-expression-history nil)

924
(defcustom eval-expression-print-level 4
Dave Love's avatar
Dave Love committed
925
  "*Value to use for `print-level' when printing value in `eval-expression'.
926
A value of nil means no limit."
927
  :group 'lisp
Dave Love's avatar
Dave Love committed
928
  :type '(choice (const :tag "No Limit" nil) integer)
929 930 931
  :version "21.1")

(defcustom eval-expression-print-length 12
Dave Love's avatar
Dave Love committed
932
  "*Value to use for `print-length' when printing value in `eval-expression'.
933
A value of nil means no limit."
934
  :group 'lisp
Dave Love's avatar
Dave Love committed
935
  :type '(choice (const :tag "No Limit" nil) integer)
936 937 938
  :version "21.1")

(defcustom eval-expression-debug-on-error t
939 940
  "*Non-nil means set `debug-on-error' when evaluating in `eval-expression'.
If nil, don't change the value of `debug-on-error'."
941 942 943 944
  :group 'lisp
  :type 'boolean
  :version "21.1")

945 946 947 948 949 950
(defun eval-expression-print-format (value)
  "Format VALUE as a result of evaluated expression.
Return a formatted string which is displayed in the echo area
in addition to the value printed by prin1 in functions which
display the result of expression evaluation."
  (if (and (integerp value)
951
           (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
952
               (eq this-command last-command)
953
               (if (boundp 'edebug-active) edebug-active)))
954
      (let ((char-string
955
             (if (or (if (boundp 'edebug-active) edebug-active)
956
                     (memq this-command '(eval-last-sexp eval-print-last-sexp)))
957 958 959 960 961
                 (prin1-char value))))
        (if char-string
            (format " (0%o, 0x%x) = %s" value value char-string)
          (format " (0%o, 0x%x)" value value)))))

962
;; We define this, rather than making `eval' interactive,
Jim Blandy's avatar
Jim Blandy committed
963
;; for the sake of completion of names like eval-region, eval-current-buffer.
964 965
(defun eval-expression (eval-expression-arg
			&optional eval-expression-insert-value)
Eli Zaretskii's avatar
Eli Zaretskii committed
966 967 968 969 970
  "Evaluate EVAL-EXPRESSION-ARG and print value in the echo area.
Value is also consed on to front of the variable `values'.
Optional argument EVAL-EXPRESSION-INSERT-VALUE, if non-nil, means
insert the result into the current buffer instead of printing it in
the echo area."
971
  (interactive
972 973
   (list (read-from-minibuffer "Eval: "
			       nil read-expression-map t
974 975
			       'read-expression-history)
	 current-prefix-arg))
976

977 978 979 980 981 982 983 984 985 986 987 988
  (if (null eval-expression-debug-on-error)
      (setq values (cons (eval eval-expression-arg) values))
    (let ((old-value (make-symbol "t")) new-value)
      ;; Bind debug-on-error to something unique so that we can
      ;; detect when evaled code changes it.
      (let ((debug-on-error old-value))
	(setq values (cons (eval eval-expression-arg) values))
	(setq