simple.el 303 KB
Newer Older
1
;;; simple.el --- basic editing commands for Emacs  -*- lexical-binding: t -*-
Eric S. Raymond's avatar
Eric S. Raymond committed
2

3
;; Copyright (C) 1985-1987, 1993-2013 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
4

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

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

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

;; 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
22
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Jim Blandy's avatar
Jim Blandy committed
23

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

31 32
(declare-function widget-convert "wid-edit" (type &rest args))
(declare-function shell-mode "shell" ())
Gerd Moellmann's avatar
Gerd Moellmann committed
33

34
;;; From compile.el
35
(defvar compilation-current-error)
36
(defvar compilation-context-lines)
37

38
(defcustom idle-update-delay 0.5
39
  "Idle time delay before updating various things on the screen.
40 41 42 43 44
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
  :group 'editing)

(defgroup paren-matching nil
  "Highlight (un)matching of parens and expressions."
  :group 'matching)
53

54
;;; next-error support framework
55 56

(defgroup next-error nil
57
  "`next-error' support framework."
58
  :group 'compilation
59
  :version "22.1")
60 61 62 63 64

(defface next-error
  '((t (:inherit region)))
  "Face used to highlight next error locus."
  :group 'next-error
65
  :version "22.1")
66

67
(defcustom next-error-highlight 0.5
68
  "Highlighting of locations in selected source buffers.
69 70 71 72
If a number, highlight the locus in `next-error' face for the given time
in seconds, or until the next command is executed.
If t, highlight the locus until the next command is executed, or until
some other locus replaces it.
73
If nil, don't highlight the locus in the source buffer.
74 75
If `fringe-arrow', indicate the locus by the fringe arrow
indefinitely until some other locus replaces it."
76
  :type '(choice (number :tag "Highlight for specified time")
77
                 (const :tag "Semipermanent highlighting" t)
78
                 (const :tag "No highlighting" nil)
79
                 (const :tag "Fringe arrow" fringe-arrow))
80
  :group 'next-error
81
  :version "22.1")
82

83
(defcustom next-error-highlight-no-select 0.5
84
  "Highlighting of locations in `next-error-no-select'.
85
If number, highlight the locus in `next-error' face for given time in seconds.
86
If t, highlight the locus indefinitely until some other locus replaces it.
87
If nil, don't highlight the locus in the source buffer.
88 89
If `fringe-arrow', indicate the locus by the fringe arrow
indefinitely until some other locus replaces it."
90
  :type '(choice (number :tag "Highlight for specified time")
91
                 (const :tag "Semipermanent highlighting" t)
92
                 (const :tag "No highlighting" nil)
93
                 (const :tag "Fringe arrow" fringe-arrow))
94
  :group 'next-error
95
  :version "22.1")
96

97
(defcustom next-error-recenter nil
98
  "Display the line in the visited source file recentered as specified.
99 100 101
If non-nil, the value is passed directly to `recenter'."
  :type '(choice (integer :tag "Line to recenter to")
                 (const :tag "Center of window" (4))
102 103 104 105
                 (const :tag "No recentering" nil))
  :group 'next-error
  :version "23.1")

Juri Linkov's avatar
Juri Linkov committed
106
(defcustom next-error-hook nil
107
  "List of hook functions run by `next-error' after visiting source file."
Juri Linkov's avatar
Juri Linkov committed
108 109 110
  :type 'hook
  :group 'next-error)

111 112
(defvar next-error-highlight-timer nil)

113
(defvar next-error-overlay-arrow-position nil)
114
(put 'next-error-overlay-arrow-position 'overlay-arrow-string (purecopy "=>"))
115 116
(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)

117
(defvar next-error-last-buffer nil
118
  "The most recent `next-error' buffer.
119 120 121 122 123
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
124 125 126 127 128 129 130 131
  "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.")
132 133
(make-variable-buffer-local 'next-error-function)

134 135 136 137 138 139 140 141
(defvar next-error-move-function nil
  "Function to use to move to an error locus.
It takes two arguments, a buffer position in the error buffer
and a buffer position in the error locus buffer.
The buffer for the error locus should already be current.
nil means use goto-char using the second argument position.")
(make-variable-buffer-local 'next-error-move-function)

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

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.

155
The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
156
that would normally be considered usable.  If it returns nil,
157 158 159 160 161 162 163 164 165 166 167 168 169 170
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
171
					 extra-test-inclusive
172
					 extra-test-exclusive)
173
  "Return a `next-error' capable buffer.
174

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
that normally would not qualify.  If it returns t, the buffer
in question is treated as usable.

182
The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
183 184
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
     (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
221
	  (message "This is the only buffer with error message locations")
222 223
	  (current-buffer)))
   ;; 6. Give up.
224
   (error "No buffers contain error message locations")))
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
To control which errors are matched, customize the variable
`compilation-error-regexp-alist'."
256
  (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
      (funcall next-error-function (prefix-numeric-value arg) reset)
262 263
      (when next-error-recenter
        (recenter next-error-recenter))
Juri Linkov's avatar
Juri Linkov committed
264
      (run-hooks 'next-error-hook))))
265

266 267 268 269 270 271
(defun next-error-internal ()
  "Visit the source code corresponding to the `next-error' message at point."
  (setq next-error-last-buffer (current-buffer))
  ;; we know here that next-error-function is a valid symbol we can funcall
  (with-current-buffer next-error-last-buffer
    (funcall next-error-function 0 nil)
272 273
    (when next-error-recenter
      (recenter next-error-recenter))
274 275
    (run-hooks 'next-error-hook)))

276 277 278
(defalias 'goto-next-locus 'next-error)
(defalias 'next-match 'next-error)

279
(defun previous-error (&optional n)
280
  "Visit previous `next-error' message and corresponding source code.
281 282 283 284 285 286

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

289
(defun first-error (&optional n)
290 291 292 293 294 295 296
  "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))

297
(defun next-error-no-select (&optional n)
298
  "Move point to the next error in the `next-error' buffer and highlight match.
299 300 301 302 303
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")
304 305
  (let ((next-error-highlight next-error-highlight-no-select))
    (next-error n))
306 307
  (pop-to-buffer next-error-last-buffer))

308
(defun previous-error-no-select (&optional n)
309
  "Move point to the previous error in the `next-error' buffer and highlight match.
310 311 312 313 314
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")
315
  (next-error-no-select (- (or n 1))))
316

317
;; Internal variable for `next-error-follow-mode-post-command-hook'.
318 319
(defvar next-error-follow-last-line nil)

Eli Zaretskii's avatar
Eli Zaretskii committed
320
(define-minor-mode next-error-follow-minor-mode
321
  "Minor mode for compilation, occur and diff modes.
322 323 324
With a prefix argument ARG, enable mode if ARG is positive, and
disable it otherwise.  If called from Lisp, enable mode if ARG is
omitted or nil.
Eli Zaretskii's avatar
Eli Zaretskii committed
325
When turned on, cursor motion in the compilation, grep, occur or diff
326
buffer causes automatic display of the corresponding source code location."
327
  :group 'next-error :init-value nil :lighter " Fol"
328
  (if (not next-error-follow-minor-mode)
329 330
      (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)
331
    (make-local-variable 'next-error-follow-last-line)))
332

333 334
;; Used as a `post-command-hook' by `next-error-follow-mode'
;; for the *Compilation* *grep* and *Occur* buffers.
335 336 337 338 339 340 341 342 343
(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))))

344

345 346
;;;

Karl Heuer's avatar
Karl Heuer committed
347 348 349 350
(defun fundamental-mode ()
  "Major mode not specialized for anything in particular.
Other major modes are defined by comparison with this one."
  (interactive)
351
  (kill-all-local-variables)
352
  (run-mode-hooks))
353

Stefan Monnier's avatar
Stefan Monnier committed
354 355 356 357 358 359
;; Special major modes to view specially formatted data rather than files.

(defvar special-mode-map
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map)
    (define-key map "q" 'quit-window)
360
    (define-key map " " 'scroll-up-command)
361
    (define-key map [?\S-\ ] 'scroll-down-command)
362
    (define-key map "\C-?" 'scroll-down-command)
Stefan Monnier's avatar
Stefan Monnier committed
363
    (define-key map "?" 'describe-mode)
364
    (define-key map "h" 'describe-mode)
Stefan Monnier's avatar
Stefan Monnier committed
365 366 367 368
    (define-key map ">" 'end-of-buffer)
    (define-key map "<" 'beginning-of-buffer)
    (define-key map "g" 'revert-buffer)
    map))
369

Stefan Monnier's avatar
Stefan Monnier committed
370 371 372 373 374
(put 'special-mode 'mode-class 'special)
(define-derived-mode special-mode nil "Special"
  "Parent major mode from which special major modes should inherit."
  (setq buffer-read-only t))

Karl Heuer's avatar
Karl Heuer committed
375 376
;; Making and deleting lines.

377 378
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
  "Propertized string representing a hard newline character.")
379

380
(defun newline (&optional arg interactive)
381
  "Insert a newline, and move to left margin of the new line if it's blank.
382
If option `use-hard-newlines' is non-nil, the newline is marked with the
Dave Love's avatar
Dave Love committed
383
text-property `hard'.
384
With ARG, insert that many newlines.
Dave Love's avatar
Dave Love committed
385
Call `auto-fill-function' if the current column number is greater
386 387 388
than the value of `fill-column' and ARG is nil.
A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
  (interactive "*P\np")
389
  (barf-if-buffer-read-only)
390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418
  ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
  ;; Set last-command-event to tell self-insert what to insert.
  (let* ((was-page-start (and (bolp) (looking-at page-delimiter)))
         (beforepos (point))
         (last-command-event ?\n)
         ;; Don't auto-fill if we have a numeric argument.
         (auto-fill-function (if arg nil auto-fill-function))
         (postproc
          ;; Do the rest in post-self-insert-hook, because we want to do it
          ;; *before* other functions on that hook.
          (lambda ()
            ;; Mark the newline(s) `hard'.
            (if use-hard-newlines
                (set-hard-newline-properties
                 (- (point) (prefix-numeric-value arg)) (point)))
            ;; If the newline leaves the previous line blank, and we
            ;; have a left margin, delete that from the blank line.
            (save-excursion
              (goto-char beforepos)
              (beginning-of-line)
              (and (looking-at "[ \t]$")
                   (> (current-left-margin) 0)
                   (delete-region (point)
                                  (line-end-position))))
            ;; 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)))))
419 420 421 422 423
    (if (not interactive)
        ;; FIXME: For non-interactive uses, many calls actually just want
        ;; (insert "\n"), so maybe we should do just that, so as to avoid
        ;; the risk of filling or running abbrevs unexpectedly.
        (let ((post-self-insert-hook (list postproc)))
424
          (self-insert-command (prefix-numeric-value arg)))
425 426 427 428 429 430 431 432
      (unwind-protect
          (progn
            (add-hook 'post-self-insert-hook postproc)
            (self-insert-command (prefix-numeric-value arg)))
        ;; We first used let-binding to protect the hook, but that was naive
        ;; since add-hook affects the symbol-default value of the variable,
        ;; whereas the let-binding might only protect the buffer-local value.
        (remove-hook 'post-self-insert-hook postproc))))
433 434
  nil)

435 436 437 438 439 440 441
(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)))))
442

443
(defun open-line (n)
444
  "Insert a newline and leave point before it.
445 446
If there is a fill prefix and/or a `left-margin', insert them
on the new line if the line would have been blank.
447
With arg N, insert N newlines."
Jim Blandy's avatar
Jim Blandy committed
448
  (interactive "*p")
449
  (let* ((do-fill-prefix (and fill-prefix (bolp)))
450
	 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
451
	 (loc (point-marker))
452 453
	 ;; Don't expand an abbrev before point.
	 (abbrev-mode nil))
454
    (newline n)
455
    (goto-char loc)
456
    (while (> n 0)
457 458 459 460
      (cond ((bolp)
	     (if do-left-margin (indent-to (current-left-margin)))
	     (if do-fill-prefix (insert-and-inherit fill-prefix))))
      (forward-line 1)
461
      (setq n (1- n)))
462 463
    (goto-char loc)
    (end-of-line)))
Jim Blandy's avatar
Jim Blandy committed
464

465 466 467
(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
468
line as well.  With prefix ARG, don't insert `fill-prefix' on new line.
469

470
When called from Lisp code, ARG may be a prefix string to copy."
471
  (interactive "*P")
Jim Blandy's avatar
Jim Blandy committed
472
  (skip-chars-forward " \t")
473 474 475 476 477 478 479 480 481 482 483
  (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))))))
484
    (newline 1)
485
    (if have-prfx (insert-and-inherit prefix))
Jim Blandy's avatar
Jim Blandy committed
486 487 488 489 490
    (indent-to col 0)
    (goto-char pos)))

(defun delete-indentation (&optional arg)
  "Join this line to previous and fix up whitespace at join.
491
If there is a fill prefix, delete it from the beginning of this line.
Jim Blandy's avatar
Jim Blandy committed
492 493 494 495 496 497 498
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)))
499 500 501
	;; If the second line started with the fill prefix,
	;; delete the prefix.
	(if (and fill-prefix
502
		 (<= (+ (point) (length fill-prefix)) (point-max))
503 504 505 506
		 (string= fill-prefix
			  (buffer-substring (point)
					    (+ (point) (length fill-prefix)))))
	    (delete-region (point) (+ (point) (length fill-prefix))))
Jim Blandy's avatar
Jim Blandy committed
507 508
	(fixup-whitespace))))

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

Jim Blandy's avatar
Jim Blandy committed
511 512 513
(defun delete-blank-lines ()
  "On blank line, delete all surrounding blank lines, leaving just one.
On isolated blank line, delete that one.
514
On nonblank line, delete any immediately following blank lines."
Jim Blandy's avatar
Jim Blandy committed
515 516 517 518 519
  (interactive "*")
  (let (thisblank singleblank)
    (save-excursion
      (beginning-of-line)
      (setq thisblank (looking-at "[ \t]*$"))
Jim Blandy's avatar
Jim Blandy committed
520
      ;; Set singleblank if there is just one blank line here.
Jim Blandy's avatar
Jim Blandy committed
521 522 523 524 525 526
      (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
527
    ;; Delete preceding blank lines, and this one too if it's the only one.
Jim Blandy's avatar
Jim Blandy committed
528 529 530 531 532 533 534 535
    (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
536 537
    ;; Delete following blank lines, unless the current line is blank
    ;; and there are no following blank lines.
Jim Blandy's avatar
Jim Blandy committed
538 539 540 541 542 543 544
    (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
545 546 547 548 549
			   (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
550

551 552 553 554 555 556
(defcustom delete-trailing-lines t
  "If non-nil, \\[delete-trailing-whitespace] deletes trailing lines.
Trailing lines are deleted only if `delete-trailing-whitespace'
is called on the entire buffer (rather than an active region)."
  :type 'boolean
  :group 'editing
557
  :version "24.3")
558

559
(defun delete-trailing-whitespace (&optional start end)
560 561 562 563 564 565 566 567 568 569 570 571 572
  "Delete trailing whitespace between START and END.
If called interactively, START and END are the start/end of the
region if the mark is active, or of the buffer's accessible
portion if the mark is inactive.

This command deletes whitespace characters after the last
non-whitespace character in each line between START and END.  It
does not consider formfeed characters to be whitespace.

If this command acts on the entire buffer (i.e. if called
interactively with the mark inactive, or called from Lisp with
END nil), it also deletes all trailing lines at the end of the
buffer if the variable `delete-trailing-lines' is non-nil."
573 574 575 576 577
  (interactive (progn
                 (barf-if-buffer-read-only)
                 (if (use-region-p)
                     (list (region-beginning) (region-end))
                   (list nil nil))))
578 579
  (save-match-data
    (save-excursion
580 581 582 583
      (let ((end-marker (copy-marker (or end (point-max))))
            (start (or start (point-min))))
        (goto-char start)
        (while (re-search-forward "\\s-$" end-marker t)
584
          (skip-syntax-backward "-" (line-beginning-position))
585
          ;; Don't delete formfeeds, even if they are considered whitespace.
586 587
          (if (looking-at-p ".*\f")
              (goto-char (match-end 0)))
588
          (delete-region (point) (match-end 0)))
589 590 591
        ;; Delete trailing empty lines.
        (goto-char end-marker)
        (when (and (not end)
592
		   delete-trailing-lines
593
                   ;; Really the end of buffer.
594
		   (= (point-max) (1+ (buffer-size)))
595
                   (<= (skip-chars-backward "\n") -2))
596
          (delete-region (1+ (point)) end-marker))
597 598 599
        (set-marker end-marker nil))))
  ;; Return nil for the benefit of `write-file-functions'.
  nil)
600

Jim Blandy's avatar
Jim Blandy committed
601 602
(defun newline-and-indent ()
  "Insert a newline, then indent according to major mode.
603
Indentation is done using the value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
604
In programming language modes, this is the same as TAB.
605
In some text modes, where TAB inserts a tab, this command indents to the
606
column specified by the function `current-left-margin'."
Jim Blandy's avatar
Jim Blandy committed
607
  (interactive "*")
608
  (delete-horizontal-space t)
Jim Blandy's avatar
Jim Blandy committed
609
  (newline)
Jim Blandy's avatar
Jim Blandy committed
610 611 612 613 614
  (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,
615
which means calling the current value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
616 617
In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this indents to the
618
column specified by the function `current-left-margin'."
Jim Blandy's avatar
Jim Blandy committed
619
  (interactive "*")
620 621 622 623 624 625
  (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)
626 627 628 629 630 631 632 633 634 635
      ;; We are at EOL before the call to indent-according-to-mode, and
      ;; after it we usually are as well, but not always.  We tried to
      ;; address it with `save-excursion' but that uses a normal marker
      ;; whereas we need `move after insertion', so we do the save/restore
      ;; by hand.
      (setq pos (copy-marker pos t))
      (indent-according-to-mode)
      (goto-char pos)
      ;; Remove the trailing white-space after indentation because
      ;; indentation may introduce the whitespace.
Kenichi Handa's avatar
Kenichi Handa committed
636
      (delete-horizontal-space t))
637
    (indent-according-to-mode)))
638

639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699
(defcustom read-quoted-char-radix 8
 "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
Legitimate radix values are 8, 10 and 16."
 :type '(choice (const 8) (const 10) (const 16))
 :group 'editing-basics)

(defun read-quoted-char (&optional prompt)
  "Like `read-char', but do not allow quitting.
Also, if the first character read is an octal digit,
we read any number of octal digits and return the
specified character code.  Any nondigit terminates the sequence.
If the terminator is RET, it is discarded;
any other terminator is used itself as input.

The optional argument PROMPT specifies a string to use to prompt the user.
The variable `read-quoted-char-radix' controls which radix to use
for numeric input."
  (let ((message-log-max nil) done (first t) (code 0) translated)
    (while (not done)
      (let ((inhibit-quit first)
	    ;; Don't let C-h get the help message--only help function keys.
	    (help-char nil)
	    (help-form
	     "Type the special character you want to use,
or the octal character code.
RET terminates the character code and is discarded;
any other non-digit terminates the character code and is then used as input."))
	(setq translated (read-key (and prompt (format "%s-" prompt))))
	(if inhibit-quit (setq quit-flag nil)))
      (if (integerp translated)
	  (setq translated (char-resolve-modifiers translated)))
      (cond ((null translated))
	    ((not (integerp translated))
	     (setq unread-command-events
                   (listify-key-sequence (this-single-command-raw-keys))
		   done t))
	    ((/= (logand translated ?\M-\^@) 0)
	     ;; Turn a meta-character into a character with the 0200 bit set.
	     (setq code (logior (logand translated (lognot ?\M-\^@)) 128)
		   done t))
	    ((and (<= ?0 translated)
                  (< translated (+ ?0 (min 10 read-quoted-char-radix))))
	     (setq code (+ (* code read-quoted-char-radix) (- translated ?0)))
	     (and prompt (setq prompt (message "%s %c" prompt translated))))
	    ((and (<= ?a (downcase translated))
		  (< (downcase translated)
                     (+ ?a -10 (min 36 read-quoted-char-radix))))
	     (setq code (+ (* code read-quoted-char-radix)
			   (+ 10 (- (downcase translated) ?a))))
	     (and prompt (setq prompt (message "%s %c" prompt translated))))
	    ((and (not first) (eq translated ?\C-m))
	     (setq done t))
	    ((not first)
	     (setq unread-command-events
                   (listify-key-sequence (this-single-command-raw-keys))
		   done t))
	    (t (setq code translated
		     done t)))
      (setq first nil))
    code))

Karl Heuer's avatar
Karl Heuer committed
700 701 702
(defun quoted-insert (arg)
  "Read next input character and insert it.
This is useful for inserting control characters.
703
With argument, insert ARG copies of the character.
Jim Blandy's avatar
Jim Blandy committed
704

Karl Heuer's avatar
Karl Heuer committed
705 706 707 708 709 710
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.
711

Karl Heuer's avatar
Karl Heuer committed
712 713 714 715
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.
716

Karl Heuer's avatar
Karl Heuer committed
717 718 719 720
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")
721 722 723 724 725 726 727 728
  (let* ((char
	  ;; Avoid "obsolete" warnings for translation-table-for-input.
	  (with-no-warnings
	    (let (translation-table-for-input input-method-function)
	      (if (or (not overwrite-mode)
		      (eq overwrite-mode 'overwrite-mode-binary))
		  (read-quoted-char)
		(read-char))))))
729 730 731 732 733 734 735 736
    ;; This used to assume character codes 0240 - 0377 stand for
    ;; characters in some single-byte character set, and converted them
    ;; to Emacs characters.  But in 23.1 this feature is deprecated
    ;; in favor of inserting the corresponding Unicode characters.
    ;; (if (and enable-multibyte-characters
    ;;          (>= char ?\240)
    ;;          (<= char ?\377))
    ;;     (setq char (unibyte-char-to-multibyte char)))
Karl Heuer's avatar
Karl Heuer committed
737 738 739 740 741 742
    (if (> arg 0)
	(if (eq overwrite-mode 'overwrite-mode-binary)
	    (delete-char arg)))
    (while (> arg 0)
      (insert-and-inherit char)
      (setq arg (1- arg)))))
743

Kenichi Handa's avatar
Kenichi Handa committed
744
(defun forward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
745
  "Move forward ARG lines and position at first nonblank character."
746
  (interactive "^p")
Kenichi Handa's avatar
Kenichi Handa committed
747
  (forward-line (or arg 1))
Karl Heuer's avatar
Karl Heuer committed
748
  (skip-chars-forward " \t"))
749

Kenichi Handa's avatar
Kenichi Handa committed
750
(defun backward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
751
  "Move backward ARG lines and position at first nonblank character."
752
  (interactive "^p")
Kenichi Handa's avatar
Kenichi Handa committed
753
  (forward-line (- (or arg 1)))
Karl Heuer's avatar
Karl Heuer committed
754
  (skip-chars-forward " \t"))
Jim Blandy's avatar
Jim Blandy committed
755

Karl Heuer's avatar
Karl Heuer committed
756 757
(defun back-to-indentation ()
  "Move point to the first non-whitespace character on this line."
758
  (interactive "^")
Karl Heuer's avatar
Karl Heuer committed
759
  (beginning-of-line 1)
760
  (skip-syntax-forward " " (line-end-position))
761 762
  ;; Move back over chars that have whitespace syntax but have the p flag.
  (backward-prefix-chars))
Karl Heuer's avatar
Karl Heuer committed
763 764 765 766 767 768 769 770 771 772 773

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

776 777
(defun delete-horizontal-space (&optional backward-only)
  "Delete all spaces and tabs around point.
778
If BACKWARD-ONLY is non-nil, only delete them before point."
779
  (interactive "*P")
780 781 782 783 784 785 786
  (let ((orig-pos (point)))
    (delete-region
     (if backward-only
	 orig-pos
       (progn
	 (skip-chars-forward " \t")
	 (constrain-to-field nil orig-pos t)))
787
     (progn
788 789
       (skip-chars-backward " \t")
       (constrain-to-field nil orig-pos)))))
Karl Heuer's avatar
Karl Heuer committed
790

791
(defun just-one-space (&optional n)
792
  "Delete all spaces and tabs around point, leaving one space (or N spaces).
793
If N is negative, delete newlines as well, leaving -N spaces."
794
  (interactive "*p")
795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833
  (cycle-spacing n nil t))

(defvar cycle-spacing--context nil
  "Store context used in consecutive calls to `cycle-spacing' command.
The first time this function is run, it saves the original point
position and original spacing around the point in this
variable.")

(defun cycle-spacing (&optional n preserve-nl-back single-shot)
  "Manipulate spaces around the point in a smart way.

When run as an interactive command, the first time it's called
in a sequence, deletes all spaces and tabs around point leaving
one (or N spaces).  If this does not change content of the
buffer, skips to the second step:

When run for the second time in a sequence, deletes all the
spaces it has previously inserted.

When run for the third time, returns the whitespace and point in
a state encountered when it had been run for the first time.

For example, if buffer contains \"foo ^ bar\" with \"^\" denoting the
point, calling `cycle-spacing' command will replace two spaces with
a single space, calling it again immediately after, will remove all
spaces, and calling it for the third time will bring two spaces back
together.

If N is negative, delete newlines as well.  However, if
PRESERVE-NL-BACK is t new line characters prior to the point
won't be removed.

If SINGLE-SHOT is non-nil, will only perform the first step.  In
other words, it will work just like `just-one-space' command."
  (interactive "*p")
  (let ((orig-pos	 (point))
	(skip-characters (if (and n (< n 0)) " \t\n\r" " \t"))
	(n		 (abs (or n 1))))
    (skip-chars-backward (if preserve-nl-back " \t" skip-characters))
834
    (constrain-to-field nil orig-pos)
835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850
    (cond
     ;; Command run for the first time or single-shot is non-nil.
     ((or single-shot
	  (not (equal last-command this-command))
	  (not cycle-spacing--context))
      (let* ((start (point))
	     (n	    (- n (skip-chars-forward " " (+ n (point)))))
	     (mid   (point))
	     (end   (progn
		      (skip-chars-forward skip-characters)
		      (constrain-to-field nil orig-pos t))))
	(setq cycle-spacing--context  ;; Save for later.
	      ;; Special handling for case where there was no space at all.
	      (unless (= start end)
		(cons orig-pos (buffer-substring start (point)))))
	;; If this run causes no change in buffer content, delete all spaces,
Paul Eggert's avatar
Paul Eggert committed
851
	;; otherwise delete all excess spaces.
852 853
	(delete-region (if (and (not single-shot) (zerop n) (= mid end))
			   start mid) end)
Sam Steingold's avatar
Sam Steingold committed
854
        (insert (make-string n ?\s))))
855 856 857 858 859 860 861 862 863 864

     ;; Command run for the second time.
     ((not (equal orig-pos (point)))
      (delete-region (point) orig-pos))

     ;; Command run for the third time.
     (t
      (insert (cdr cycle-spacing--context))
      (goto-char (car cycle-spacing--context))
      (setq cycle-spacing--context nil)))))
865

Jim Blandy's avatar
Jim Blandy committed
866
(defun beginning-of-buffer (&optional arg)
867
  "Move point to the beginning of the buffer.
868
With numeric arg N, put point N/10 of the way from the beginning.
869 870
If the buffer is narrowed, this command uses the beginning of the
accessible part of the buffer.
871

872 873
If Transient Mark mode is disabled, leave mark at previous
position, unless a \\[universal-argument] prefix is supplied.
874 875

Don't use this command in Lisp programs!
876
\(goto-char (point-min)) is faster."
877
  (interactive "^P")
878
  (or (consp arg)
879
      (region-active-p)
880
      (push-mark))
881
  (let ((size (- (point-max) (point-min))))
882
    (goto-char (if (and arg (not (consp arg)))
883 884 885 886 887 888 889
		   (+ (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))))
890
  (if (and arg (not (consp arg))) (forward-line 1)))
Jim Blandy's avatar
Jim Blandy committed
891 892

(defun end-of-buffer (&optional arg)
893
  "Move point to the end of the buffer.
894
With numeric arg N, put point N/10 of the way from the end.
895 896
If the buffer is narrowed, this command uses the end of the
accessible part of the buffer.
897

898 899
If Transient Mark mode is disabled, leave mark at previous
position, unless a \\[universal-argument] prefix is supplied.
900 901

Don't use this command in Lisp programs!
902
\(goto-char (point-max)) is faster."
903
  (interactive "^P")
904
  (or (consp arg) (region-active-p) (push-mark))
905
  (let ((size (- (point-max) (point-min))))
906
    (goto-char (if (and arg (not (consp arg)))
907 908 909 910 911 912 913
		   (- (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
914 915
  ;; If we went to a place in the middle of the buffer,
  ;; adjust it to the beginning of a line.
916
  (cond ((and arg (not (consp arg))) (forward-line 1))
917 918
	((and (eq (current-buffer) (window-buffer))
              (> (point) (window-end nil t)))
919 920 921 922
	 ;; 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
923

924 925 926 927 928 929 930 931 932 933 934
(defcustom delete-active-region t
  "Whether single-char deletion commands delete an active region.
This has an effect only if Transient Mark mode is enabled, and
affects `delete-forward-char' and `delete-backward-char', though
not `delete-char'.

If the value is the symbol `kill', the active region is killed
instead of deleted."
  :type '(choice (const :tag "Delete active region" t)
                 (const :tag "Kill active region" kill)
                 (const :tag "Do ordinary deletion" nil))
935
  :group 'killing
936