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

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

5
;; Maintainer: emacs-devel@gnu.org
Pavel Janík's avatar
Pavel Janík committed
6
;; 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
(eval-when-compile (require 'cl-lib))

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

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

40
(defcustom shell-command-dont-erase-buffer nil
41 42 43 44 45 46 47 48 49 50 51 52
  "If non-nil, output buffer is not erased between shell commands.
Also, a non-nil value set the point in the output buffer
once the command complete.
The value `beg-last-out' set point at the beginning of the output,
`end-last-out' set point at the end of the buffer, `save-point'
restore the buffer position before the command."
  :type '(choice
          (const :tag "Erase buffer" nil)
          (const :tag "Set point to beginning of last output" beg-last-out)
          (const :tag "Set point to end of last output" end-last-out)
          (const :tag "Save point" save-point))
  :group 'shell
53
  :version "26.1")
54 55 56 57 58

(defvar shell-command-saved-pos nil
  "Point position in the output buffer after command complete.
It is an alist (BUFFER . POS), where BUFFER is the output
buffer, and POS is the point position in BUFFER once the command finish.
59
This variable is used when `shell-command-dont-erase-buffer' is non-nil.")
60

61
(defcustom idle-update-delay 0.5
62
  "Idle time delay before updating various things on the screen.
63 64 65 66 67
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
68

69
(defgroup killing nil
70
  "Killing and yanking commands."
71 72 73 74 75
  :group 'editing)

(defgroup paren-matching nil
  "Highlight (un)matching of parens and expressions."
  :group 'matching)
76

77
;;; next-error support framework
78 79

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

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

90
(defcustom next-error-highlight 0.5
91
  "Highlighting of locations in selected source buffers.
92 93 94 95
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.
96
If nil, don't highlight the locus in the source buffer.
97 98
If `fringe-arrow', indicate the locus by the fringe arrow
indefinitely until some other locus replaces it."
99
  :type '(choice (number :tag "Highlight for specified time")
100
                 (const :tag "Semipermanent highlighting" t)
101
                 (const :tag "No highlighting" nil)
102
                 (const :tag "Fringe arrow" fringe-arrow))
103
  :group 'next-error
104
  :version "22.1")
105

106
(defcustom next-error-highlight-no-select 0.5
107
  "Highlighting of locations in `next-error-no-select'.
108
If number, highlight the locus in `next-error' face for given time in seconds.
109
If t, highlight the locus indefinitely until some other locus replaces it.
110
If nil, don't highlight the locus in the source buffer.
111 112
If `fringe-arrow', indicate the locus by the fringe arrow
indefinitely until some other locus replaces it."
113
  :type '(choice (number :tag "Highlight for specified time")
114
                 (const :tag "Semipermanent highlighting" t)
115
                 (const :tag "No highlighting" nil)
116
                 (const :tag "Fringe arrow" fringe-arrow))
117
  :group 'next-error
118
  :version "22.1")
119

120
(defcustom next-error-recenter nil
121
  "Display the line in the visited source file recentered as specified.
122 123 124
If non-nil, the value is passed directly to `recenter'."
  :type '(choice (integer :tag "Line to recenter to")
                 (const :tag "Center of window" (4))
125 126 127 128
                 (const :tag "No recentering" nil))
  :group 'next-error
  :version "23.1")

Juri Linkov's avatar
Juri Linkov committed
129
(defcustom next-error-hook nil
130
  "List of hook functions run by `next-error' after visiting source file."
Juri Linkov's avatar
Juri Linkov committed
131 132 133
  :type 'hook
  :group 'next-error)

134 135
(defvar next-error-highlight-timer nil)

136
(defvar next-error-overlay-arrow-position nil)
137
(put 'next-error-overlay-arrow-position 'overlay-arrow-string (purecopy "=>"))
138 139
(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)

140
(defvar next-error-last-buffer nil
141
  "The most recent `next-error' buffer.
142 143 144 145 146
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
147 148 149 150 151 152 153 154
  "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.")
155 156
(make-variable-buffer-local 'next-error-function)

157 158 159 160 161 162 163 164
(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)

165
(defsubst next-error-buffer-p (buffer
166
			       &optional avoid-current
167
			       extra-test-inclusive
168
			       extra-test-exclusive)
169 170 171 172 173 174 175 176 177 178 179 180
  "Return non-nil if BUFFER is a `next-error' capable buffer.
If AVOID-CURRENT is non-nil, and BUFFER is the current buffer,
return nil.

The function EXTRA-TEST-INCLUSIVE, if non-nil, is called if
BUFFER would not normally qualify.  If it returns non-nil, BUFFER
is considered `next-error' capable, anyway, and the function
returns non-nil.

The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called if the
buffer would normally qualify.  If it returns nil, BUFFER is
rejected, and the function returns nil."
181 182 183 184 185 186 187 188 189 190 191 192 193
  (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
194
					 extra-test-inclusive
195
					 extra-test-exclusive)
196
  "Return a `next-error' capable buffer.
197

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

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

205
The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
206 207
that would normally be considered usable.  If it returns nil,
that buffer is rejected."
208 209 210 211 212 213
  (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
214 215
				    (window-buffer w)
                                    avoid-current
216
                                    extra-test-inclusive extra-test-exclusive)
217 218 219 220
                                   (window-buffer w)))
                             (window-list))))))
     (if (eq (length window-buffers) 1)
         (car window-buffers)))
221
   ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
222
   (if (and next-error-last-buffer
223
            (next-error-buffer-p next-error-last-buffer avoid-current
224
                                 extra-test-inclusive extra-test-exclusive))
225 226 227 228
       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)
229
       (current-buffer))
230
   ;; 4. Look for any acceptable buffer.
231 232
   (let ((buffers (buffer-list)))
     (while (and buffers
233 234 235
                 (not (next-error-buffer-p
		       (car buffers) avoid-current
		       extra-test-inclusive extra-test-exclusive)))
236
       (setq buffers (cdr buffers)))
237 238 239 240 241 242 243
     (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
244
	  (message "This is the only buffer with error message locations")
245 246
	  (current-buffer)))
   ;; 6. Give up.
247
   (error "No buffers contain error message locations")))
248

249
(defun next-error (&optional arg reset)
250
  "Visit next `next-error' message and corresponding source code.
251 252 253 254

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

255
A prefix ARG specifies how many error messages to move;
256 257 258 259
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.

260
The RESET argument specifies that we should restart from the beginning.
261 262 263 264 265 266

\\[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
267 268 269 270
`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.
271

Juri Linkov's avatar
Juri Linkov committed
272 273 274 275
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.
276

277 278
To control which errors are matched, customize the variable
`compilation-error-regexp-alist'."
279
  (interactive "P")
280
  (if (consp arg) (setq reset t arg nil))
281 282 283
  (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
284
      (funcall next-error-function (prefix-numeric-value arg) reset)
285 286
      (when next-error-recenter
        (recenter next-error-recenter))
Juri Linkov's avatar
Juri Linkov committed
287
      (run-hooks 'next-error-hook))))
288

289 290 291 292 293 294
(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)
295 296
    (when next-error-recenter
      (recenter next-error-recenter))
297 298
    (run-hooks 'next-error-hook)))

299 300 301
(defalias 'goto-next-locus 'next-error)
(defalias 'next-match 'next-error)

302
(defun previous-error (&optional n)
303
  "Visit previous `next-error' message and corresponding source code.
304 305 306 307 308 309

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

312
(defun first-error (&optional n)
313 314 315 316 317 318 319
  "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))

320
(defun next-error-no-select (&optional n)
321
  "Move point to the next error in the `next-error' buffer and highlight match.
322 323 324 325 326
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")
327 328
  (let ((next-error-highlight next-error-highlight-no-select))
    (next-error n))
329 330
  (pop-to-buffer next-error-last-buffer))

331
(defun previous-error-no-select (&optional n)
332
  "Move point to the previous error in the `next-error' buffer and highlight match.
333 334 335 336 337
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")
338
  (next-error-no-select (- (or n 1))))
339

340
;; Internal variable for `next-error-follow-mode-post-command-hook'.
341 342
(defvar next-error-follow-last-line nil)

Eli Zaretskii's avatar
Eli Zaretskii committed
343
(define-minor-mode next-error-follow-minor-mode
344
  "Minor mode for compilation, occur and diff modes.
345 346 347
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
348
When turned on, cursor motion in the compilation, grep, occur or diff
349
buffer causes automatic display of the corresponding source code location."
350
  :group 'next-error :init-value nil :lighter " Fol"
351
  (if (not next-error-follow-minor-mode)
352 353
      (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)
354
    (make-local-variable 'next-error-follow-last-line)))
355

356 357
;; Used as a `post-command-hook' by `next-error-follow-mode'
;; for the *Compilation* *grep* and *Occur* buffers.
358 359 360 361 362 363 364 365 366
(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))))

367

368 369
;;;

Karl Heuer's avatar
Karl Heuer committed
370 371 372 373
(defun fundamental-mode ()
  "Major mode not specialized for anything in particular.
Other major modes are defined by comparison with this one."
  (interactive)
374
  (kill-all-local-variables)
375
  (run-mode-hooks))
376

377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397
;; 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)
    (define-key map " " 'scroll-up-command)
    (define-key map [?\S-\ ] 'scroll-down-command)
    (define-key map "\C-?" 'scroll-down-command)
    (define-key map "?" 'describe-mode)
    (define-key map "h" 'describe-mode)
    (define-key map ">" 'end-of-buffer)
    (define-key map "<" 'beginning-of-buffer)
    (define-key map "g" 'revert-buffer)
    map))

(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
398 399
;; Making and deleting lines.

400 401 402 403 404 405 406
(defvar self-insert-uses-region-functions nil
  "Special hook to tell if `self-insert-command' will use the region.
It must be called via `run-hook-with-args-until-success' with no arguments.
Any `post-self-insert-command' which consumes the region should
register a function on this hook so that things like `delete-selection-mode'
can refrain from consuming the region.")

407 408
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
  "Propertized string representing a hard newline character.")
409

410
(defun newline (&optional arg interactive)
411
  "Insert a newline, and move to left margin of the new line if it's blank.
412
If option `use-hard-newlines' is non-nil, the newline is marked with the
Dave Love's avatar
Dave Love committed
413
text-property `hard'.
414
With ARG, insert that many newlines.
415

416 417 418
If `electric-indent-mode' is enabled, this indents the final new line
that it adds, and reindents the preceding line.  To just insert
a newline, use \\[electric-indent-just-newline].
419 420

Calls `auto-fill-function' if the current column number is greater
421
than the value of `fill-column' and ARG is nil.
422
A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
423
  (interactive "*P\np")
424
  (barf-if-buffer-read-only)
425 426 427 428 429 430 431
  ;; 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))
Eli Zaretskii's avatar
Eli Zaretskii committed
432
         (arg (prefix-numeric-value arg))
433 434 435 436
         (postproc
          ;; Do the rest in post-self-insert-hook, because we want to do it
          ;; *before* other functions on that hook.
          (lambda ()
Eli Zaretskii's avatar
Eli Zaretskii committed
437 438 439 440
            ;; We are not going to insert any newlines if arg is
            ;; non-positive.
            (or (and (numberp arg) (<= arg 0))
                (cl-assert (eq ?\n (char-before))))
441 442 443
            ;; Mark the newline(s) `hard'.
            (if use-hard-newlines
                (set-hard-newline-properties
Eli Zaretskii's avatar
Eli Zaretskii committed
444
                 (- (point) arg) (point)))
445 446 447 448 449 450 451 452 453 454 455 456 457 458
            ;; 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)))))
459 460
    (unwind-protect
        (if (not interactive)
Eli Zaretskii's avatar
Eli Zaretskii committed
461 462 463 464 465 466 467 468 469 470 471 472 473 474 475
            ;; 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)))
              (self-insert-command arg))
          (unwind-protect
              (progn
                (add-hook 'post-self-insert-hook postproc nil t)
                (self-insert-command 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 t)))
476 477
      (cl-assert (not (member postproc post-self-insert-hook)))
      (cl-assert (not (member postproc (default-value 'post-self-insert-hook))))))
478 479
  nil)

480 481 482 483 484 485 486
(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)))))
487

488
(defun open-line (n)
489
  "Insert a newline and leave point before it.
490
If there is a fill prefix and/or a `left-margin', insert them on
491
the new line if the line would have been blank.
492 493
With arg N, insert N newlines."
  (interactive "*p")
494
  (let* ((do-fill-prefix (and fill-prefix (bolp)))
495
	 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
496
	 (loc (point-marker))
497
         ;; Don't expand an abbrev before point.
498
	 (abbrev-mode nil))
499
    (newline n)
500
    (goto-char loc)
501
    (while (> n 0)
502 503 504 505
      (cond ((bolp)
	     (if do-left-margin (indent-to (current-left-margin)))
	     (if do-fill-prefix (insert-and-inherit fill-prefix))))
      (forward-line 1)
506
      (setq n (1- n)))
507
    (goto-char loc)
508
    ;; Necessary in case a margin or prefix was inserted.
509
    (end-of-line)))
Jim Blandy's avatar
Jim Blandy committed
510

511 512 513
(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
514
line as well.  With prefix ARG, don't insert `fill-prefix' on new line.
515

516
When called from Lisp code, ARG may be a prefix string to copy."
517
  (interactive "*P")
Jim Blandy's avatar
Jim Blandy committed
518
  (skip-chars-forward " \t")
519 520 521 522 523 524 525 526 527 528 529
  (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))))))
530
    (newline 1)
531
    (if have-prfx (insert-and-inherit prefix))
Jim Blandy's avatar
Jim Blandy committed
532 533 534 535 536
    (indent-to col 0)
    (goto-char pos)))

(defun delete-indentation (&optional arg)
  "Join this line to previous and fix up whitespace at join.
537
If there is a fill prefix, delete it from the beginning of this line.
Jim Blandy's avatar
Jim Blandy committed
538 539 540 541 542 543 544
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)))
545 546 547
	;; If the second line started with the fill prefix,
	;; delete the prefix.
	(if (and fill-prefix
548
		 (<= (+ (point) (length fill-prefix)) (point-max))
549 550 551 552
		 (string= fill-prefix
			  (buffer-substring (point)
					    (+ (point) (length fill-prefix)))))
	    (delete-region (point) (+ (point) (length fill-prefix))))
Jim Blandy's avatar
Jim Blandy committed
553 554
	(fixup-whitespace))))

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

Jim Blandy's avatar
Jim Blandy committed
557 558 559
(defun delete-blank-lines ()
  "On blank line, delete all surrounding blank lines, leaving just one.
On isolated blank line, delete that one.
560
On nonblank line, delete any immediately following blank lines."
Jim Blandy's avatar
Jim Blandy committed
561 562 563 564 565
  (interactive "*")
  (let (thisblank singleblank)
    (save-excursion
      (beginning-of-line)
      (setq thisblank (looking-at "[ \t]*$"))
Jim Blandy's avatar
Jim Blandy committed
566
      ;; Set singleblank if there is just one blank line here.
Jim Blandy's avatar
Jim Blandy committed
567 568 569 570 571 572
      (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
573
    ;; Delete preceding blank lines, and this one too if it's the only one.
Jim Blandy's avatar
Jim Blandy committed
574 575 576 577 578 579 580 581
    (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
582 583
    ;; Delete following blank lines, unless the current line is blank
    ;; and there are no following blank lines.
Jim Blandy's avatar
Jim Blandy committed
584 585 586 587 588 589 590
    (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
591 592 593 594 595
			   (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
596

597 598 599 600 601 602
(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
603
  :version "24.3")
604

605
(defun region-modifiable-p (start end)
Glenn Morris's avatar
Glenn Morris committed
606
  "Return non-nil if the region contains no read-only text."
607 608 609
  (and (not (get-text-property start 'read-only))
       (eq end (next-single-property-change start 'read-only nil end))))

610
(defun delete-trailing-whitespace (&optional start end)
611 612 613 614 615 616 617 618 619 620 621 622 623
  "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."
624 625 626 627 628
  (interactive (progn
                 (barf-if-buffer-read-only)
                 (if (use-region-p)
                     (list (region-beginning) (region-end))
                   (list nil nil))))
629 630
  (save-match-data
    (save-excursion
631
      (let ((end-marker (and end (copy-marker end))))
632 633
        (goto-char (or start (point-min)))
        (with-syntax-table (make-syntax-table (syntax-table))
634
          ;; Don't delete formfeeds, even if they are considered whitespace.
635
          (modify-syntax-entry ?\f "_")
636 637 638
          ;; Treating \n as non-whitespace makes things easier.
          (modify-syntax-entry ?\n "_")
          (while (re-search-forward "\\s-+$" end-marker t)
639 640 641
            (let ((b (match-beginning 0)) (e (match-end 0)))
              (when (region-modifiable-p b e)
                (delete-region b e)))))
642 643 644 645 646 647 648
        (if end
            (set-marker end-marker nil)
          ;; Delete trailing empty lines.
          (and delete-trailing-lines
               ;; Really the end of buffer.
               (= (goto-char (point-max)) (1+ (buffer-size)))
               (<= (skip-chars-backward "\n") -2)
649
               (region-modifiable-p (1+ (point)) (point-max))
650
               (delete-region (1+ (point)) (point-max)))))))
651 652
  ;; Return nil for the benefit of `write-file-functions'.
  nil)
653

Jim Blandy's avatar
Jim Blandy committed
654 655
(defun newline-and-indent ()
  "Insert a newline, then indent according to major mode.
656
Indentation is done using the value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
657
In programming language modes, this is the same as TAB.
658
In some text modes, where TAB inserts a tab, this command indents to the
659
column specified by the function `current-left-margin'."
Jim Blandy's avatar
Jim Blandy committed
660
  (interactive "*")
661
  (delete-horizontal-space t)
662
  (newline nil t)
Jim Blandy's avatar
Jim Blandy committed
663 664 665 666 667
  (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,
668
which means calling the current value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
669 670
In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this indents to the
671
column specified by the function `current-left-margin'."
Jim Blandy's avatar
Jim Blandy committed
672
  (interactive "*")
673 674 675 676 677 678
  (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)
679 680 681 682 683 684 685 686 687 688
      ;; 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
689
      (delete-horizontal-space t))
690
    (indent-according-to-mode)))
691

692
(defcustom read-quoted-char-radix 8
693
  "Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
694 695 696 697 698 699 700 701 702 703 704 705 706 707 708
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."
709 710 711
  (let ((message-log-max nil)
	(help-events (delq nil (mapcar (lambda (c) (unless (characterp c) c))
				       help-event-list)))
712
	done (first t) (code 0) char translated)
713 714
    (while (not done)
      (let ((inhibit-quit first)
715 716
	    ;; Don't let C-h or other help chars get the help
	    ;; message--only help function keys.  See bug#16617.
717
	    (help-char nil)
718
	    (help-event-list help-events)
719 720 721 722 723
	    (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."))
724
	(setq char (read-event (and prompt (format "%s-" prompt)) t))
725
	(if inhibit-quit (setq quit-flag nil)))
726 727 728 729 730 731 732 733
      ;; Translate TAB key into control-I ASCII character, and so on.
      ;; Note: `read-char' does it using the `ascii-character' property.
      ;; We tried using read-key instead, but that disables the keystroke
      ;; echo produced by 'C-q', see bug#24635.
      (let ((translation (lookup-key local-function-key-map (vector char))))
	(setq translated (if (arrayp translation)
			     (aref translation 0)
			   char)))
734 735 736 737
      (if (integerp translated)
	  (setq translated (char-resolve-modifiers translated)))
      (cond ((null translated))
	    ((not (integerp translated))
738
	     (setq unread-command-events (list char)
739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756
		   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)
757
	     (setq unread-command-events (list char)
758 759 760 761 762 763
		   done t))
	    (t (setq code translated
		     done t)))
      (setq first nil))
    code))

Karl Heuer's avatar
Karl Heuer committed
764 765 766
(defun quoted-insert (arg)
  "Read next input character and insert it.
This is useful for inserting control characters.
767
With argument, insert ARG copies of the character.
Jim Blandy's avatar
Jim Blandy committed
768

Karl Heuer's avatar
Karl Heuer committed
769 770 771 772 773 774
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.
775

Karl Heuer's avatar
Karl Heuer committed
776 777 778 779
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.
780

Karl Heuer's avatar
Karl Heuer committed
781 782 783 784
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")
785 786 787 788 789 790 791 792
  (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))))))
793 794 795 796 797 798 799 800
    ;; 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)))
801 802 803
    (unless (characterp char)
      (user-error "%s is not a valid character"
		  (key-description (vector char))))
Karl Heuer's avatar
Karl Heuer committed
804 805 806 807 808 809
    (if (> arg 0)
	(if (eq overwrite-mode 'overwrite-mode-binary)
	    (delete-char arg)))
    (while (> arg 0)
      (insert-and-inherit char)
      (setq arg (1- arg)))))
810

Kenichi Handa's avatar
Kenichi Handa committed
811
(defun forward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
812
  "Move forward ARG lines and position at first nonblank character."
813
  (interactive "^p")
Kenichi Handa's avatar
Kenichi Handa committed
814
  (forward-line (or arg 1))
Karl Heuer's avatar
Karl Heuer committed
815
  (skip-chars-forward " \t"))
816

Kenichi Handa's avatar
Kenichi Handa committed
817
(defun backward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
818
  "Move backward ARG lines and position at first nonblank character."
819
  (interactive "^p")
Kenichi Handa's avatar
Kenichi Handa committed
820
  (forward-line (- (or arg 1)))
Karl Heuer's avatar
Karl Heuer committed
821
  (skip-chars-forward " \t"))
Jim Blandy's avatar
Jim Blandy committed
822

Karl Heuer's avatar
Karl Heuer committed
823 824
(defun back-to-indentation ()
  "Move point to the first non-whitespace character on this line."
825
  (interactive "^")
Karl Heuer's avatar
Karl Heuer committed
826
  (beginning-of-line 1)
827
  (skip-syntax-forward " " (line-end-position))
828 829
  ;; Move back over chars that have whitespace syntax but have the p flag.
  (backward-prefix-chars))
Karl Heuer's avatar
Karl Heuer committed
830 831 832 833 834 835 836 837 838 839 840

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

843 844
(defun delete-horizontal-space (&optional backward-only)
  "Delete all spaces and tabs around point.
845
If BACKWARD-ONLY is non-nil, only delete them before point."
846
  (interactive "*P")
847 848 849 850 851 852 853
  (let ((orig-pos (point)))
    (delete-region
     (if backward-only
	 orig-pos
       (progn
	 (skip-chars-forward " \t")
	 (constrain-to-field nil orig-pos t)))
854
     (progn
855 856
       (skip-chars-backward " \t")
       (constrain-to-field nil orig-pos)))))
Karl Heuer's avatar
Karl Heuer committed
857

858
(defun just-one-space (&optional n)
859
  "Delete all spaces and tabs around point, leaving one space (or N spaces).
Glenn Morris's avatar
Glenn Morris committed
860 861
If N is negative, delete newlines as well, leaving -N spaces.
See also `cycle-spacing'."
862
  (interactive "*p")
863
  (cycle-spacing n nil 'single-shot))
864 865 866

(defvar cycle-spacing--context nil
  "Store context used in consecutive calls to `cycle-spacing' command.
867 868 869
The first time `cycle-spacing' runs, it saves in this variable:
its N argument, the original point position, and the original spacing
around point.")
870

871
(defun cycle-spacing (&optional n preserve-nl-back mode)
Glenn Morris's avatar
Glenn Morris committed
872
  "Manipulate whitespace around point in a smart way.
873 874
In interactive use, this function behaves differently in successive
consecutive calls.
875

876 877 878 879 880
The first call in a sequence acts like `just-one-space'.
It deletes all spaces and tabs around point, leaving one space
\(or N spaces).  N is the prefix argument.  If N is negative,
it deletes newlines as well, leaving -N spaces.
\(If PRESERVE-NL-BACK is non-nil, it does not delete newlines before point.)
881

882
The second call in a sequence deletes all spaces.
883

884
The third call in a sequence restores the original whitespace (and point).
885

886 887 888 889
If MODE is `single-shot', it only performs the first step in the sequence.
If MODE is `fast' and the first step would not result in any change
\(i.e., there are exactly (abs N) spaces around point),
the function goes straight to the second step.
890

891 892
Repeatedly calling the function with different values of N starts a
new sequence each time."
893 894 895
  (interactive "*p")
  (let ((orig-pos	 (point))
	(skip-characters (if (and n (< n 0)) " \t\n\r" " \t"))
896
	(num		 (abs (or n 1))))
897
    (skip-chars-backward (if preserve-nl-back " \t" skip-characters))
898
    (constrain-to-field nil orig-pos)
899
    (cond
900 901
     ;; Command run for the first time, single-shot mode or different argument
     ((or (eq 'single-shot mode)
902
	  (not (equal last-command this-command))
903 904
	  (not cycle-spacing--context)
	  (not (eq (car cycle-spacing--context) n)))
905
      (let* ((start (point))
906
	     (num   (- num (skip-chars-forward " " (+ num (point)))))
907 908 909 910 911 912 913
	     (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)
914
                (cons n (cons orig-pos (buffer-substring start (point))))))
915
	;; If this run causes no change in buffer content, delete all spaces,
Paul Eggert's avatar
Paul Eggert committed
916
	;; otherwise delete all excess spaces.
917
	(delete-region (if (and (eq mode 'fast) (zerop num) (= mid end))
918
			   start mid) end)
919
        (insert (make-string num ?\s))))
920 921 922 923 924 925 926

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

     ;; Command run for the third time.
     (t
927 928
      (insert (cddr cycle-spacing--context))
      (goto-char (cadr cycle-spacing--context))
929
      (setq cycle-spacing--context nil)))))
930

Jim Blandy's avatar
Jim Blandy committed
931
(defun beginning-of-buffer (&optional arg)
932
  "Move point to the beginning of the buffer.
933
With numeric arg N, put point N/10 of the way from the beginning.
934 935
If the buffer is narrowed, this command uses the beginning of the
accessible part of the buffer.
936

937 938
Push mark at previous position, unless either a \\[universal-argument] prefix
is supplied, or Transient Mark mode is enabled and the mark is active."
939
  (declare (interactive-only "use `(goto-char (point-min))' instead."))
940
  (interactive "^P")
941
  (or (consp arg)
942
      (region-active-p)
943
      (push-mark))
944
  (let ((size (- (point-max) (point-min))))
945
    (goto-char (if (and arg (not (consp arg)))
946 947 948 949 950 951 952
		   (+ (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))))
953
  (if (and arg (not (consp arg))) (forward-line 1)))
Jim Blandy's avatar
Jim Blandy committed
954 955

(defun end-of-buffer (&optional arg)
956
  "Move point to the end of the buffer.
957
With numeric arg N, put point N/10 of the way from the end.
958 959
If the buffer is narrowed, this command uses the end of the
accessible part of the buffer.
960

961 962
Push mark at previous position, unless either a \\[universal-argument] prefix
is supplied, or Transient Mark mode is enabled and the mark is active."
963
  (declare (interactive-only "use `(goto-char (point-max))' instead."))