simple.el 203 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 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
5

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

Jim Blandy's avatar
Jim Blandy committed
9 10 11 12
;; 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
13
;; the Free Software Foundation; either version 2, or (at your option)
Jim Blandy's avatar
Jim Blandy committed
14 15 16 17 18 19 20 21
;; 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
22
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
23 24
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Jim Blandy's avatar
Jim Blandy committed
25

26 27 28 29 30
;;; 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
31
;;; Code:
Jim Blandy's avatar
Jim Blandy committed
32

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

37 38
(defvar compilation-current-error)

39 40 41 42 43 44 45
(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
46

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

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

55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
(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)))
74

75
;;; next-error support framework
76 77

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

(defface next-error
  '((t (:inherit region)))
  "Face used to highlight next error locus."
  :group 'next-error
86
  :version "22.1")
87 88 89

(defcustom next-error-highlight 0.1
  "*Highlighting of locations in selected source buffers.
90 91
If number, highlight the locus in `next-error' face for given time in seconds.
If t, use persistent overlays fontified in `next-error' face.
92 93 94 95 96 97 98
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
99
  :version "22.1")
100 101 102

(defcustom next-error-highlight-no-select 0.1
  "*Highlighting of locations in non-selected source buffers.
103 104
If number, highlight the locus in `next-error' face for given time in seconds.
If t, use persistent overlays fontified in `next-error' face.
105 106 107 108 109 110 111
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
112
  :version "22.1")
113

Juri Linkov's avatar
Juri Linkov committed
114 115 116 117 118
(defcustom next-error-hook nil
  "*List of hook functions run by `next-error' after visiting source file."
  :type 'hook
  :group 'next-error)

119 120
(defvar next-error-highlight-timer nil)

121
(defvar next-error-overlay-arrow-position nil)
122
(put 'next-error-overlay-arrow-position 'overlay-arrow-string "=>")
123 124
(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)

125
(defvar next-error-last-buffer nil
126
  "The most recent `next-error' buffer.
127 128 129 130 131
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
132 133 134 135 136 137 138 139
  "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.")
140 141 142

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

143
(defsubst next-error-buffer-p (buffer
144
			       &optional avoid-current
145
			       extra-test-inclusive
146
			       extra-test-exclusive)
147
  "Test if BUFFER is a `next-error' capable buffer.
148 149 150 151 152 153 154 155 156

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
157
that would normally be considered usable.  If it returns nil,
158 159 160 161 162 163 164 165 166 167 168 169 170 171
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
172
					 extra-test-inclusive
173
					 extra-test-exclusive)
174
  "Return a `next-error' capable buffer.
175 176 177
If AVOID-CURRENT is non-nil, treat the current buffer
as an absolute last resort only.

178
The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
179 180 181 182 183 184
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."
185 186 187 188 189 190
  (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
191 192
				    (window-buffer w)
                                    avoid-current
193
                                    extra-test-inclusive extra-test-exclusive)
194 195 196 197
                                   (window-buffer w)))
                             (window-list))))))
     (if (eq (length window-buffers) 1)
         (car window-buffers)))
198
   ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
199
   (if (and next-error-last-buffer
200
            (next-error-buffer-p next-error-last-buffer avoid-current
201
                                 extra-test-inclusive extra-test-exclusive))
202 203 204 205
       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)
206
       (current-buffer))
207
   ;; 4. Look for any acceptable buffer.
208 209
   (let ((buffers (buffer-list)))
     (while (and buffers
210 211 212
                 (not (next-error-buffer-p
		       (car buffers) avoid-current
		       extra-test-inclusive extra-test-exclusive)))
213
       (setq buffers (cdr buffers)))
214 215 216 217 218 219 220 221 222 223 224
     (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")))
225

226
(defun next-error (&optional arg reset)
227
  "Visit next `next-error' message and corresponding source code.
228 229 230 231

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

232
A prefix ARG specifies how many error messages to move;
233 234 235 236
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.

237
The RESET argument specifies that we should restart from the beginning.
238 239 240 241 242 243

\\[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
244 245 246 247
`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.
248

Juri Linkov's avatar
Juri Linkov committed
249 250 251 252
Once \\[next-error] has chosen the buffer for error messages, it
runs `next-error-hook' with `run-hooks', and stays with that buffer
until you use it in some other buffer which uses Compilation mode
or Compilation Minor mode.
253 254 255 256

See variables `compilation-parse-errors-function' and
\`compilation-error-regexp-alist' for customization ideas."
  (interactive "P")
257
  (if (consp arg) (setq reset t arg nil))
258 259 260
  (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
Juri Linkov's avatar
Juri Linkov committed
261 262
      (funcall next-error-function (prefix-numeric-value arg) reset)
      (run-hooks 'next-error-hook))))
263 264 265 266

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

267
(defun previous-error (&optional n)
268
  "Visit previous `next-error' message and corresponding source code.
269 270 271 272 273 274

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")
275
  (next-error (- (or n 1))))
276

277
(defun first-error (&optional n)
278 279 280 281 282 283 284
  "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))

285
(defun next-error-no-select (&optional n)
286
  "Move point to the next error in the `next-error' buffer and highlight match.
287 288 289 290 291
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")
292 293
  (let ((next-error-highlight next-error-highlight-no-select))
    (next-error n))
294 295
  (pop-to-buffer next-error-last-buffer))

296
(defun previous-error-no-select (&optional n)
297
  "Move point to the previous error in the `next-error' buffer and highlight match.
298 299 300 301 302
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")
303
  (next-error-no-select (- (or n 1))))
304

305 306 307
;;; Internal variable for `next-error-follow-mode-post-command-hook'.
(defvar next-error-follow-last-line nil)

Eli Zaretskii's avatar
Eli Zaretskii committed
308
(define-minor-mode next-error-follow-minor-mode
309
  "Minor mode for compilation, occur and diff modes.
Eli Zaretskii's avatar
Eli Zaretskii committed
310 311 312
When turned on, cursor motion in the compilation, grep, occur or diff
buffer causes automatic display of the corresponding source code
location."
313
  :group 'next-error :init-value nil :lighter " Fol"
314
  (if (not next-error-follow-minor-mode)
315 316
      (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)
317
    (make-local-variable 'next-error-follow-last-line)))
318 319 320 321 322 323 324 325 326 327 328 329

;;; 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))))

330

331 332
;;;

Karl Heuer's avatar
Karl Heuer committed
333 334 335 336
(defun fundamental-mode ()
  "Major mode not specialized for anything in particular.
Other major modes are defined by comparison with this one."
  (interactive)
337
  (kill-all-local-variables)
338 339
  (unless delay-mode-hooks
    (run-hooks 'after-change-major-mode-hook)))
340

Karl Heuer's avatar
Karl Heuer committed
341 342
;; Making and deleting lines.

343
(defun newline (&optional arg)
344
  "Insert a newline, and move to left margin of the new line if it's blank.
Dave Love's avatar
Dave Love committed
345 346
If `use-hard-newlines' is non-nil, the newline is marked with the
text-property `hard'.
347
With ARG, insert that many newlines.
Dave Love's avatar
Dave Love committed
348
Call `auto-fill-function' if the current column number is greater
349
than the value of `fill-column' and ARG is nil."
350
  (interactive "*P")
351
  (barf-if-buffer-read-only)
352 353 354 355
  ;; 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.
356
  (let ((flag (and (not (bobp))
357
		   (bolp)
358 359 360 361
		   ;; Make sure no functions want to be told about
		   ;; the range of the changes.
		   (not after-change-functions)
		   (not before-change-functions)
362 363
		   ;; Make sure there are no markers here.
		   (not (buffer-has-markers-at (1- (point))))
364
		   (not (buffer-has-markers-at (point)))
365 366 367 368 369 370
		   ;; 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)))
371 372 373 374 375 376 377 378
		   ;; 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).
379
		   (< (or (previous-property-change (point)) -2)
380 381 382 383
		      (- (point) 2))))
	(was-page-start (and (bolp)
			     (looking-at page-delimiter)))
	(beforepos (point)))
384 385 386 387 388
    (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.
389 390 391
	  ;; 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)))
392 393 394 395
      (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))))
396 397 398 399
    ;; 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.

400 401
    ;; Mark the newline(s) `hard'.
    (if use-hard-newlines
402
	(set-hard-newline-properties
403
	 (- (point) (if arg (prefix-numeric-value arg) 1)) (point)))
404 405 406 407 408 409 410 411 412 413 414 415 416 417
    ;; 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)))
418 419
  nil)

420 421 422 423 424 425 426
(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)))))
427

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

450 451 452
(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
453
line as well.  With prefix ARG, don't insert `fill-prefix' on new line.
454

455
When called from Lisp code, ARG may be a prefix string to copy."
456
  (interactive "*P")
Jim Blandy's avatar
Jim Blandy committed
457
  (skip-chars-forward " \t")
458 459 460 461 462 463 464 465 466 467 468
  (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))))))
469
    (newline 1)
470
    (if have-prfx (insert-and-inherit prefix))
Jim Blandy's avatar
Jim Blandy committed
471 472 473 474 475
    (indent-to col 0)
    (goto-char pos)))

(defun delete-indentation (&optional arg)
  "Join this line to previous and fix up whitespace at join.
476
If there is a fill prefix, delete it from the beginning of this line.
Jim Blandy's avatar
Jim Blandy committed
477 478 479 480 481 482 483
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)))
484 485 486
	;; If the second line started with the fill prefix,
	;; delete the prefix.
	(if (and fill-prefix
487
		 (<= (+ (point) (length fill-prefix)) (point-max))
488 489 490 491
		 (string= fill-prefix
			  (buffer-substring (point)
					    (+ (point) (length fill-prefix)))))
	    (delete-region (point) (+ (point) (length fill-prefix))))
Jim Blandy's avatar
Jim Blandy committed
492 493
	(fixup-whitespace))))

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

Jim Blandy's avatar
Jim Blandy committed
496 497 498
(defun delete-blank-lines ()
  "On blank line, delete all surrounding blank lines, leaving just one.
On isolated blank line, delete that one.
499
On nonblank line, delete any immediately following blank lines."
Jim Blandy's avatar
Jim Blandy committed
500 501 502 503 504
  (interactive "*")
  (let (thisblank singleblank)
    (save-excursion
      (beginning-of-line)
      (setq thisblank (looking-at "[ \t]*$"))
Jim Blandy's avatar
Jim Blandy committed
505
      ;; Set singleblank if there is just one blank line here.
Jim Blandy's avatar
Jim Blandy committed
506 507 508 509 510 511
      (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
512
    ;; Delete preceding blank lines, and this one too if it's the only one.
Jim Blandy's avatar
Jim Blandy committed
513 514 515 516 517 518 519 520
    (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
521 522
    ;; Delete following blank lines, unless the current line is blank
    ;; and there are no following blank lines.
Jim Blandy's avatar
Jim Blandy committed
523 524 525 526 527 528 529
    (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
530 531 532 533 534
			   (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
535

536 537 538
(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.
539 540
This respects narrowing, created by \\[narrow-to-region] and friends.
A formfeed is not considered whitespace by this function."
541 542 543 544
  (interactive "*")
  (save-match-data
    (save-excursion
      (goto-char (point-min))
545 546
      (while (re-search-forward "\\s-$" nil t)
	(skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
547
	;; Don't delete formfeeds, even if they are considered whitespace.
548 549 550
	(save-match-data
	  (if (looking-at ".*\f")
	      (goto-char (match-end 0))))
551
	(delete-region (point) (match-end 0))))))
552

Jim Blandy's avatar
Jim Blandy committed
553 554
(defun newline-and-indent ()
  "Insert a newline, then indent according to major mode.
555
Indentation is done using the value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
556
In programming language modes, this is the same as TAB.
557
In some text modes, where TAB inserts a tab, this command indents to the
558
column specified by the function `current-left-margin'."
Jim Blandy's avatar
Jim Blandy committed
559
  (interactive "*")
560
  (delete-horizontal-space t)
Jim Blandy's avatar
Jim Blandy committed
561
  (newline)
Jim Blandy's avatar
Jim Blandy committed
562 563 564 565 566
  (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,
567
which means calling the current value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
568 569
In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this indents to the
570
column specified by the function `current-left-margin'."
Jim Blandy's avatar
Jim Blandy committed
571
  (interactive "*")
572 573 574 575 576 577
  (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)
578 579
      (indent-according-to-mode)
      (delete-horizontal-space t))
580
    (indent-according-to-mode)))
581

Karl Heuer's avatar
Karl Heuer committed
582 583 584
(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
585

Karl Heuer's avatar
Karl Heuer committed
586 587 588 589 590 591
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.
592

Karl Heuer's avatar
Karl Heuer committed
593 594 595 596
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.
597

Karl Heuer's avatar
Karl Heuer committed
598 599 600 601
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")
602
  (let* ((char (let (translation-table-for-input)
603 604 605 606
		 (if (or (not overwrite-mode)
			 (eq overwrite-mode 'overwrite-mode-binary))
		     (read-quoted-char)
		   (read-char)))))
Karl Heuer's avatar
Karl Heuer committed
607 608 609 610 611 612 613 614 615 616 617 618 619
    ;; 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)))))
620

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

627
(defun backward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
628 629
  "Move backward ARG lines and position at first nonblank character."
  (interactive "p")
630
  (forward-line (- (or arg 1)))
Karl Heuer's avatar
Karl Heuer committed
631
  (skip-chars-forward " \t"))
Jim Blandy's avatar
Jim Blandy committed
632

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

(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
651
      (insert ?\s))))
Karl Heuer's avatar
Karl Heuer committed
652

653 654 655
(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
656
  (interactive "*")
657 658 659 660 661 662 663
  (let ((orig-pos (point)))
    (delete-region
     (if backward-only
	 orig-pos
       (progn
	 (skip-chars-forward " \t")
	 (constrain-to-field nil orig-pos t)))
664
     (progn
665 666
       (skip-chars-backward " \t")
       (constrain-to-field nil orig-pos)))))
Karl Heuer's avatar
Karl Heuer committed
667

668
(defun just-one-space (&optional n)
669 670
  "Delete all spaces and tabs around point, leaving one space (or N spaces)."
  (interactive "*p")
671 672 673
  (let ((orig-pos (point)))
    (skip-chars-backward " \t")
    (constrain-to-field nil orig-pos)
674
    (dotimes (i (or n 1))
675
      (if (= (following-char) ?\s)
676
	  (forward-char 1)
677
	(insert ?\s)))
678 679 680 681 682
    (delete-region
     (point)
     (progn
       (skip-chars-forward " \t")
       (constrain-to-field nil orig-pos t)))))
683

Jim Blandy's avatar
Jim Blandy committed
684 685
(defun beginning-of-buffer (&optional arg)
  "Move point to the beginning of the buffer; leave mark at previous position.
686 687
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.
688 689 690

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

Don't use this command in Lisp programs!
Jim Blandy's avatar
Jim Blandy committed
693 694
\(goto-char (point-min)) is faster and avoids clobbering the mark."
  (interactive "P")
695
  (or (consp arg)
696 697
      (and transient-mark-mode mark-active)
      (push-mark))
698
  (let ((size (- (point-max) (point-min))))
699
    (goto-char (if (and arg (not (consp arg)))
700 701 702 703 704 705 706
		   (+ (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
707 708 709 710
  (if arg (forward-line 1)))

(defun end-of-buffer (&optional arg)
  "Move point to the end of the buffer; leave mark at previous position.
711 712
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.
713 714 715

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

Don't use this command in Lisp programs!
Jim Blandy's avatar
Jim Blandy committed
718 719
\(goto-char (point-max)) is faster and avoids clobbering the mark."
  (interactive "P")
720
  (or (consp arg)
721 722
      (and transient-mark-mode mark-active)
      (push-mark))
723
  (let ((size (- (point-max) (point-min))))
724
    (goto-char (if (and arg (not (consp arg)))
725 726 727 728 729 730 731
		   (- (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
732 733
  ;; If we went to a place in the middle of the buffer,
  ;; adjust it to the beginning of a line.
734
  (cond (arg (forward-line 1))
735
	((> (point) (window-end nil t))
736 737 738 739
	 ;; 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
740 741

(defun mark-whole-buffer ()
Jim Blandy's avatar
Jim Blandy committed
742 743 744 745
  "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
746 747
  (interactive)
  (push-mark (point))
748
  (push-mark (point-max) nil t)
Jim Blandy's avatar
Jim Blandy committed
749
  (goto-char (point-min)))
750

751

Karl Heuer's avatar
Karl Heuer committed
752 753
;; Counting lines, one way or another.

754 755
(defun goto-line (arg &optional buffer)
  "Goto line ARG, counting from line 1 at beginning of buffer.
Eli Zaretskii's avatar
Eli Zaretskii committed
756 757 758 759
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.
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 790 791 792 793 794 795 796

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
797 798 799 800 801
  (save-restriction
    (widen)
    (goto-char 1)
    (if (eq selective-display t)
	(re-search-forward "[\n\C-m]" nil 'end (1- arg))
802
      (forward-line (1- arg)))))
Jim Blandy's avatar
Jim Blandy committed
803 804

(defun count-lines-region (start end)
805
  "Print number of lines and characters in the region."
Jim Blandy's avatar
Jim Blandy committed
806 807 808 809 810
  (interactive "r")
  (message "Region has %d lines, %d characters"
	   (count-lines start end) (- end start)))

(defun what-line ()
811
  "Print the current buffer line number and narrowed line number of point."
Jim Blandy's avatar
Jim Blandy committed
812
  (interactive)
813
  (let ((start (point-min))
814
	(n (line-number-at-pos)))
Kim F. Storm's avatar
Kim F. Storm committed
815 816 817 818 819
    (if (= start 1)
	(message "Line %d" n)
      (save-excursion
	(save-restriction
	  (widen)
Luc Teirlinck's avatar
Luc Teirlinck committed
820
	  (message "line %d (narrowed line %d)"
821
		   (+ n (line-number-at-pos start) -1) n))))))
822

Jim Blandy's avatar
Jim Blandy committed
823 824 825
(defun count-lines (start end)
  "Return number of lines between START and END.
This is usually the number of newlines between them,
826
but can be one more if START is not equal to END
Jim Blandy's avatar
Jim Blandy committed
827
and the greater of them is not at the start of a line."
828 829 830 831 832 833
  (save-excursion
    (save-restriction
      (narrow-to-region start end)
      (goto-char (point-min))
      (if (eq selective-display t)
	  (save-match-data
834 835 836 837 838
	    (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)))
839 840 841 842
	      (goto-char (point-max))
	      (if (and (/= start end)
		       (not (bolp)))
		  (1+ done)
843 844
		done)))
	(- (buffer-size) (forward-line (buffer-size)))))))
845

846
(defun line-number-at-pos (&optional pos)
Kim F. Storm's avatar
Kim F. Storm committed
847 848 849 850 851 852 853 854 855 856
  "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))))))

857 858
(defun what-cursor-position (&optional detail)
  "Print info on cursor position (on screen and within buffer).
859
Also describe the character after point, and give its character code
860 861 862 863 864 865 866
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.
867

868
In addition, with prefix argument, show details about that character
869
in *Help* buffer.  See also the command `describe-char'."
870
  (interactive "P")
Jim Blandy's avatar
Jim Blandy committed
871 872 873 874 875 876 877 878 879 880 881 882 883 884 885
  (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)))
886
	    (message "point=%d of %d (%d%%) <%d - %d> column %d %s"
Jim Blandy's avatar
Jim Blandy committed
887
		     pos total percent beg end col hscroll)
888
	  (message "point=%d of %d (%d%%) column %d %s"
Jim Blandy's avatar
Jim Blandy committed
889
		   pos total percent col hscroll))
890 891 892 893 894
      (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))
895 896 897 898 899 900
	(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
901
		    (format "(0%o, %d, 0x%x, file %s)"
902
			    char char char
903
			    (if (> (length encoded) 1)
904
				"..."
905
			      (encoded-string-description encoded coding)))
906
		  (format "(0%o, %d, 0x%x)" char char char))))
907
	(if detail
908
	    ;; We show the detailed information about CHAR.
909
	    (describe-char (point)))
910 911
	(if (or (/= beg 1) (/= end (1+ total)))
	    (message "Char: %s %s point=%d of %d (%d%%) <%d - %d> column %d %s"
912 913
		     (if (< char 256)
			 (single-key-description char)
914
		       (buffer-substring-no-properties (point) (1+ (point))))
915 916 917 918 919 920
		     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))))))
921

922 923 924 925 926
(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)
927 928
  "Minibuffer keymap used for reading Lisp expressions.")

929 930
(defvar read-expression-history nil)

931
(defcustom eval-expression-print-level 4
Luc Teirlinck's avatar
Luc Teirlinck committed
932
  "Value for `print-level' while 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-print-length 12
Luc Teirlinck's avatar
Luc Teirlinck committed
939
  "Value for `print-length' while printing value in `eval-expression'.
940
A value of nil means no limit."
941
  :group 'lisp
Dave Love's avatar
Dave Love committed
942
  :type '(choice (const :tag "No Limit" nil) integer)
943 944 945
  :version "21.1")

(defcustom eval-expression-debug-on-error t
Luc Teirlinck's avatar
Luc Teirlinck committed
946
  "If non-nil set `debug-on-error' to t in `eval-expression'.
947
If nil, don't change the value of `debug-on-error'."
948 949 950 951
  :group 'lisp
  :type 'boolean
  :version "21.1")

952 953 954 955 956 957
(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)
958
           (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
959
               (eq this-command last-command)
960
               (if (boundp 'edebug-active) edebug-active)))
961
      (let ((char-string
962
             (if (or (if (boundp 'edebug-active) edebug-active)
963
                     (memq this-command '(eval-last-sexp eval-print-last-sexp)))
964 965 966 967 968
                 (prin1-char value))))
        (if char-string
            (format " (0%o, 0x%x) = %s" value value char-string)
          (format " (0%o, 0x%x)" value value)))))

969
;; We define this, rather than making `eval' interactive,
Jim Blandy's avatar
Jim Blandy committed
970
;; for the sake of completion of names like eval-region, eval-current-buffer.
971 972
(defun eval-expression (eval-expression-arg
			&optional eval-expression-insert-value)
Eli Zaretskii's avatar
Eli Zaretskii committed
973 974 975 976 977
  "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."
978
  (interactive
979 980
   (list (read-from-minibuffer "Eval: "
			       nil read-expression-map t
981 982
			       'read-expression-history)
	 current-prefix-arg))
983

984 985 986 987 988 989 990 991 992 993 994 995
  (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 new-value debug-on-error))
      ;; If evaled code has changed the value of debug-on-error,
      ;; propagate that change to the global binding.
      (unless (eq old-value new-value)
	(setq debug-on-error new-value))))
996

997 998
  (let ((print-length eval-expression-print-length)
	(print-level eval-expression-print-level))
999 1000
    (if eval-expression-insert-value
	(with-no-warnings
1001 1002
	 (let ((standard-output (current-buffer)))
	   (eval-last-sexp-print-value (car values))))
1003 1004 1005 1006
      (prog1
          (prin1 (car values) t)
        (let ((str (eval-expression-print-format (car values))))
          (if str (princ str t)))))))
Jim Blandy's avatar
Jim Blandy committed
1007 1008 1009 1010 1011

(defun edit-and-eval-command (prompt command)
  "Prompting with PROMPT, let user edit COMMAND and eval result.
COMMAND is a Lisp expression.  Let user edit that expression in
the minibuffer, then read and evaluate the result."
1012
  (let ((command
1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023
	 (let ((print-level nil)
	       (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
	   (unwind-protect
	       (read-from-minibuffer prompt
				     (prin1-to-string command)
				     read-expression-map t
				     'command-history)
	     ;; If command was added to command-history as a string,
	     ;; get rid of that.  We want only evaluable expressions there.
	     (if (stringp (car command-history))
		 (setq command-history (cdr command-history)))))))
1024 1025 1026 1027 1028

    ;; If command to be redone does not match front of history,
    ;; add it to the history.
    (or (equal command (car command-history))
	(setq command-history (cons command command-history)))
Jim Blandy's avatar
Jim Blandy committed
1029