simple.el 370 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-2019 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 <https://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 idle-update-delay 0.5
41
  "Idle time delay before updating various things on the screen.
42 43 44 45 46
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
47

48 49 50 51 52 53 54 55
(defvar amalgamating-undo-limit 20
  "The maximum number of changes to possibly amalgamate when undoing changes.
The `undo' command will normally consider \"similar\" changes
(like inserting characters) to be part of the same change.  This
is called \"amalgamating\" the changes.  This variable says what
the maximum number of changes condidered is when amalgamating.  A
value of 1 means that nothing is amalgamated.")

56
(defgroup killing nil
57
  "Killing and yanking commands."
58 59 60 61 62
  :group 'editing)

(defgroup paren-matching nil
  "Highlight (un)matching of parens and expressions."
  :group 'matching)
63

64
;;; next-error support framework
65 66

(defgroup next-error nil
67
  "`next-error' support framework."
68
  :group 'compilation
69
  :version "22.1")
70 71 72 73 74

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

77
(defcustom next-error-highlight 0.5
78
  "Highlighting of locations in selected source buffers.
79 80 81 82
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.
83
If nil, don't highlight the locus in the source buffer.
84 85
If `fringe-arrow', indicate the locus by the fringe arrow
indefinitely until some other locus replaces it."
86
  :type '(choice (number :tag "Highlight for specified time")
87
                 (const :tag "Semipermanent highlighting" t)
88
                 (const :tag "No highlighting" nil)
89
                 (const :tag "Fringe arrow" fringe-arrow))
90
  :group 'next-error
91
  :version "22.1")
92

93
(defcustom next-error-highlight-no-select 0.5
94
  "Highlighting of locations in `next-error-no-select'.
95
If number, highlight the locus in `next-error' face for given time in seconds.
96
If t, highlight the locus indefinitely until some other locus replaces it.
97
If nil, don't highlight the locus in the source buffer.
98 99
If `fringe-arrow', indicate the locus by the fringe arrow
indefinitely until some other locus replaces it."
100
  :type '(choice (number :tag "Highlight for specified time")
101
                 (const :tag "Semipermanent highlighting" t)
102
                 (const :tag "No highlighting" nil)
103
                 (const :tag "Fringe arrow" fringe-arrow))
104
  :group 'next-error
105
  :version "22.1")
106

107
(defcustom next-error-recenter nil
108
  "Display the line in the visited source file recentered as specified.
109 110 111
If non-nil, the value is passed directly to `recenter'."
  :type '(choice (integer :tag "Line to recenter to")
                 (const :tag "Center of window" (4))
112 113 114 115
                 (const :tag "No recentering" nil))
  :group 'next-error
  :version "23.1")

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

121 122 123
(defcustom next-error-verbose t
  "If non-nil, `next-error' always outputs the current error buffer.
If nil, the message is output only when the error buffer
124 125 126 127 128 129
changes."
  :group 'next-error
  :type 'boolean
  :safe #'booleanp
  :version "27.1")

130 131
(defvar next-error-highlight-timer nil)

132
(defvar next-error-overlay-arrow-position nil)
133
(put 'next-error-overlay-arrow-position 'overlay-arrow-string (purecopy "=>"))
134 135
(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)

136
(defvar next-error-last-buffer nil
137
  "The most recent `next-error' buffer.
138 139 140
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].")
141

142 143 144
(defvar next-error-buffer nil
  "The buffer-local value of the most recent `next-error' buffer.")
;; next-error-buffer is made buffer-local to keep the reference
145 146 147
;; to the parent buffer used to navigate to the current buffer, so the
;; next call of next-buffer will use the same parent buffer to
;; continue navigation from it.
148
(make-variable-buffer-local 'next-error-buffer)
149 150

(defvar next-error-function nil
151 152 153 154 155 156 157 158
  "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.")
159 160
(make-variable-buffer-local 'next-error-function)

161 162 163 164 165 166 167 168
(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)

169
(defsubst next-error-buffer-p (buffer
170
			       &optional avoid-current
171
			       extra-test-inclusive
172
			       extra-test-exclusive)
173 174 175 176 177 178 179 180 181 182 183 184
  "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."
185 186 187 188 189 190 191 192 193 194 195 196
  (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))))))

197
(defcustom next-error-find-buffer-function #'ignore
198 199
  "Function called to find a `next-error' capable buffer.
This functions takes the same three arguments as the function
200 201 202 203 204 205
`next-error-find-buffer', and should return the buffer to be
used by the subsequent invocation of the command `next-error'
and `previous-error'.
If the function returns nil, `next-error-find-buffer' will
try to use the buffer it used previously, and failing that
all other buffers."
206 207
  :type '(choice (const :tag "No default" ignore)
                 (const :tag "Single next-error capable buffer on selected frame"
208 209 210 211 212
                        next-error-buffer-on-selected-frame)
                 (function :tag "Other function"))
  :group 'next-error
  :version "27.1")

213 214 215 216 217 218 219 220 221 222
(defcustom next-error-found-function #'ignore
  "Function called when a next locus is found and displayed.
Function is called with two arguments: a FROM-BUFFER buffer
from which next-error navigated, and a target buffer TO-BUFFER."
  :type '(choice (const :tag "No default" ignore)
                 (function :tag "Other function"))
  :group 'next-error
  :version "27.1")

(defun next-error-buffer-on-selected-frame (&optional _avoid-current
223 224 225 226 227 228 229 230
                                                      extra-test-inclusive
                                                      extra-test-exclusive)
  "Return a single visible next-error buffer on the selected frame."
  (let ((window-buffers
         (delete-dups
          (delq nil (mapcar (lambda (w)
                              (if (next-error-buffer-p
				   (window-buffer w)
231
                                   t
232 233 234 235 236 237
                                   extra-test-inclusive extra-test-exclusive)
                                  (window-buffer w)))
                            (window-list))))))
    (if (eq (length window-buffers) 1)
        (car window-buffers))))

238
(defun next-error-find-buffer (&optional avoid-current
239
					 extra-test-inclusive
240
					 extra-test-exclusive)
241
  "Return a `next-error' capable buffer.
242

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

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

250
The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
251 252
that would normally be considered usable.  If it returns nil,
that buffer is rejected."
253
  (or
254
   ;; 1. If a customizable function returns a buffer, use it.
255 256 257
   (funcall next-error-find-buffer-function avoid-current
                                            extra-test-inclusive
                                            extra-test-exclusive)
258 259 260 261 262 263 264 265 266
   ;; 2. If next-error-buffer has no buffer-local value
   ;; (i.e. never navigated to the current buffer from another),
   ;; and the current buffer is a `next-error' capable buffer,
   ;; use it unconditionally, so next-error will always use it.
   (if (and (not (local-variable-p 'next-error-buffer))
            (next-error-buffer-p (current-buffer) avoid-current
			         extra-test-inclusive extra-test-exclusive))
       (current-buffer))
   ;; 3. If next-error-last-buffer is an acceptable buffer, use that.
267
   (if (and next-error-last-buffer
268
            (next-error-buffer-p next-error-last-buffer avoid-current
269
                                 extra-test-inclusive extra-test-exclusive))
270
       next-error-last-buffer)
271
   ;; 4. If the current buffer is acceptable, choose it.
272 273
   (if (next-error-buffer-p (current-buffer) avoid-current
			    extra-test-inclusive extra-test-exclusive)
274
       (current-buffer))
275
   ;; 5. Look for any acceptable buffer.
276 277
   (let ((buffers (buffer-list)))
     (while (and buffers
278 279 280
                 (not (next-error-buffer-p
		       (car buffers) avoid-current
		       extra-test-inclusive extra-test-exclusive)))
281
       (setq buffers (cdr buffers)))
282
     (car buffers))
283
   ;; 6. Use the current buffer as a last resort if it qualifies,
284 285 286 287 288
   ;; even despite AVOID-CURRENT.
   (and avoid-current
	(next-error-buffer-p (current-buffer) nil
			     extra-test-inclusive extra-test-exclusive)
	(progn
289
	  (message "This is the only buffer with error message locations")
290
	  (current-buffer)))
291
   ;; 7. Give up.
292
   (error "No buffers contain error message locations")))
293

294
(defun next-error (&optional arg reset)
295
  "Visit next `next-error' message and corresponding source code.
296 297 298 299

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

300
A prefix ARG specifies how many error messages to move;
301 302 303 304
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.

305
The RESET argument specifies that we should restart from the beginning.
306 307 308 309 310 311

\\[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
312 313
`next-error-function' is bound to an appropriate function.
To specify use of a particular buffer for error messages, type
314 315 316
\\[next-error] in that buffer.  You can also use the command
`next-error-select-buffer' to select the buffer to use for the subsequent
invocation of `next-error'.
317

Juri Linkov's avatar
Juri Linkov committed
318 319 320 321
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.
322

323 324
To control which errors are matched, customize the variable
`compilation-error-regexp-alist'."
325
  (interactive "P")
326
  (if (consp arg) (setq reset t arg nil))
327 328 329 330 331
  (let ((buffer (next-error-find-buffer)))
    (when buffer
      ;; We know here that next-error-function is a valid symbol we can funcall
      (with-current-buffer buffer
        (funcall next-error-function (prefix-numeric-value arg) reset)
332 333
        (let ((prev next-error-last-buffer))
          (next-error-found buffer (current-buffer))
334
          (when (or next-error-verbose
335 336 337 338 339 340 341
                    (not (eq prev next-error-last-buffer)))
            (message "%s locus from %s"
                     (cond (reset                             "First")
                           ((eq (prefix-numeric-value arg) 0) "Current")
                           ((< (prefix-numeric-value arg) 0)  "Previous")
                           (t                                 "Next"))
                     next-error-last-buffer)))))))
342

343 344
(defun next-error-internal ()
  "Visit the source code corresponding to the `next-error' message at point."
345 346
  (let ((buffer (current-buffer)))
    ;; We know here that next-error-function is a valid symbol we can funcall
347
    (funcall next-error-function 0 nil)
348 349
    (let ((prev next-error-last-buffer))
      (next-error-found buffer (current-buffer))
350
      (when (or next-error-verbose
351 352
                (not (eq prev next-error-last-buffer)))
        (message "Current locus from %s" next-error-last-buffer)))))
353 354 355 356 357 358 359 360 361 362 363 364 365

(defun next-error-found (&optional from-buffer to-buffer)
  "Function to call when the next locus is found and displayed.
FROM-BUFFER is a buffer from which next-error navigated,
and TO-BUFFER is a target buffer."
  (setq next-error-last-buffer (or from-buffer (current-buffer)))
  (when to-buffer
    (with-current-buffer to-buffer
      (setq next-error-buffer from-buffer)))
  (when next-error-recenter
    (recenter next-error-recenter))
  (funcall next-error-found-function from-buffer to-buffer)
  (run-hooks 'next-error-hook))
366

367
(defun next-error-select-buffer (buffer)
368 369
  "Select a `next-error' capable BUFFER and set it as the last used.
This means that the selected buffer becomes the source of locations
370 371 372
for the subsequent invocation of `next-error' or `previous-error'.
Interactively, this command allows selection only among buffers
where `next-error-function' is bound to an appropriate function."
373 374 375 376
  (interactive
   (list (get-buffer
          (read-buffer "Select next-error buffer: " nil nil
                       (lambda (b) (next-error-buffer-p (cdr b)))))))
377
  (setq next-error-last-buffer buffer))
378

379 380 381
(defalias 'goto-next-locus 'next-error)
(defalias 'next-match 'next-error)

382
(defun previous-error (&optional n)
383
  "Visit previous `next-error' message and corresponding source code.
384 385 386 387

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

388 389 390
This operates on the output from the \\[compile] and \\[grep] commands.

See `next-error' for the details."
391
  (interactive "p")
392
  (next-error (- (or n 1))))
393

394
(defun first-error (&optional n)
395 396 397 398 399 400 401
  "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))

402
(defun next-error-no-select (&optional n)
403
  "Move point to the next error in the `next-error' buffer and highlight match.
404 405 406 407 408
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")
409 410 411 412 413
  (save-selected-window
    (let ((next-error-highlight next-error-highlight-no-select)
          (display-buffer-overriding-action
           '(nil (inhibit-same-window . t))))
      (next-error n))))
414

415
(defun previous-error-no-select (&optional n)
416
  "Move point to the previous error in the `next-error' buffer and highlight match.
417 418 419 420 421
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")
422
  (next-error-no-select (- (or n 1))))
423

424
;; Internal variable for `next-error-follow-mode-post-command-hook'.
425 426
(defvar next-error-follow-last-line nil)

Eli Zaretskii's avatar
Eli Zaretskii committed
427
(define-minor-mode next-error-follow-minor-mode
428
  "Minor mode for compilation, occur and diff modes.
429

Eli Zaretskii's avatar
Eli Zaretskii committed
430
When turned on, cursor motion in the compilation, grep, occur or diff
431
buffer causes automatic display of the corresponding source code location."
432
  :group 'next-error :init-value nil :lighter " Fol"
433
  (if (not next-error-follow-minor-mode)
434 435
      (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)
436
    (make-local-variable 'next-error-follow-last-line)))
437

438 439
;; Used as a `post-command-hook' by `next-error-follow-mode'
;; for the *Compilation* *grep* and *Occur* buffers.
440 441 442 443 444 445 446 447 448
(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))))

449

450 451
;;;

Karl Heuer's avatar
Karl Heuer committed
452 453 454 455
(defun fundamental-mode ()
  "Major mode not specialized for anything in particular.
Other major modes are defined by comparison with this one."
  (interactive)
456
  (kill-all-local-variables)
457
  (run-mode-hooks))
458

459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476
;; 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"
477 478 479 480
  "Parent major mode from which special major modes should inherit.

A special major mode is intended to view specially formatted data
rather than files.  These modes usually use read-only buffers."
481 482
  (setq buffer-read-only t))

Karl Heuer's avatar
Karl Heuer committed
483 484
;; Making and deleting lines.

485 486 487
(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.
488 489 490 491 492 493 494 495 496 497 498 499

If any function on this hook returns a non-nil value, `delete-selection-mode'
will act on that value (see `delete-selection-helper'), and will
usually delete the region.  If all the functions on this hook return
nil, it is an indiction that `self-insert-command' needs the region
untouched by `delete-selection-mode', and will itself do whatever is
appropriate with the region.
Any function on `post-self-insert-hook' which act on the region should
add a function to this hook so that `delete-selection-mode' could
refrain from deleting the region before `post-self-insert-hook'
functions are called.
This hook is run by `delete-selection-uses-region-p', which see.")
500

501 502
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
  "Propertized string representing a hard newline character.")
503

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

510 511 512
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].
513

514 515 516
If `auto-fill-mode' is enabled, this may cause automatic line
breaking of the preceding line.  A non-nil ARG inhibits this.

517
A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
518
  (interactive "*P\np")
519
  (barf-if-buffer-read-only)
520
  ;; Call self-insert so that auto-fill, abbrev expansion etc. happen.
521 522 523 524
  ;; 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)
525
         ;; Don't auto-fill if we have a prefix argument.
526
         (auto-fill-function (if arg nil auto-fill-function))
Eli Zaretskii's avatar
Eli Zaretskii committed
527
         (arg (prefix-numeric-value arg))
528 529 530 531 532 533 534
         (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
Eli Zaretskii's avatar
Eli Zaretskii committed
535
                 (- (point) arg) (point)))
536 537 538 539 540 541 542 543 544 545 546 547 548 549
            ;; 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)))))
550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565
    (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)))
	  (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))))
566 567
  nil)

568 569 570 571 572 573 574
(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)))))
575

576
(defun open-line (n)
577
  "Insert a newline and leave point before it.
578
If there is a fill prefix and/or a `left-margin', insert them on
579
the new line if the line would have been blank.
580 581
With arg N, insert N newlines."
  (interactive "*p")
582
  (let* ((do-fill-prefix (and fill-prefix (bolp)))
583
	 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
584
	 (loc (point-marker))
585
         ;; Don't expand an abbrev before point.
586
	 (abbrev-mode nil))
587
    (newline n)
588
    (goto-char loc)
589
    (while (> n 0)
590 591 592 593
      (cond ((bolp)
	     (if do-left-margin (indent-to (current-left-margin)))
	     (if do-fill-prefix (insert-and-inherit fill-prefix))))
      (forward-line 1)
594
      (setq n (1- n)))
595
    (goto-char loc)
596
    ;; Necessary in case a margin or prefix was inserted.
597
    (end-of-line)))
Jim Blandy's avatar
Jim Blandy committed
598

599 600 601
(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
602
line as well.  With prefix ARG, don't insert `fill-prefix' on new line.
603

604
When called from Lisp code, ARG may be a prefix string to copy."
605
  (interactive "*P")
Jim Blandy's avatar
Jim Blandy committed
606
  (skip-chars-forward " \t")
607 608 609 610 611 612 613 614 615 616 617
  (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))))))
618
    (newline 1)
619
    (if have-prfx (insert-and-inherit prefix))
Jim Blandy's avatar
Jim Blandy committed
620 621 622
    (indent-to col 0)
    (goto-char pos)))

623
(defun delete-indentation (&optional arg beg end)
Jim Blandy's avatar
Jim Blandy committed
624
  "Join this line to previous and fix up whitespace at join.
625
If there is a fill prefix, delete it from the beginning of this
626 627
line.
With prefix ARG, join the current line to the following line.
628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655
When BEG and END are non-nil, join all lines in the region they
define.  Interactively, BEG and END are, respectively, the start
and end of the region if it is active, else nil.  (The region is
ignored if prefix ARG is given.)"
  (interactive
   (progn (barf-if-buffer-read-only)
          (cons current-prefix-arg
                (and (use-region-p)
                     (list (region-beginning) (region-end))))))
  ;; Consistently deactivate mark even when no text is changed.
  (setq deactivate-mark t)
  (if (and beg (not arg))
      ;; Region is active.  Go to END, but only if region spans
      ;; multiple lines.
      (and (goto-char beg)
           (> end (line-end-position))
           (goto-char end))
    ;; Region is inactive.  Set a loop sentinel
    ;; (subtracting 1 in order to compare less than BOB).
    (setq beg (1- (line-beginning-position (and arg 2))))
    (when arg (forward-line)))
  (let ((prefix (and (> (length fill-prefix) 0)
                     (regexp-quote fill-prefix))))
    (while (and (> (line-beginning-position) beg)
                (forward-line 0)
                (= (preceding-char) ?\n))
      (delete-char -1)
      ;; If the appended line started with the fill prefix,
656
      ;; delete the prefix.
657 658 659
      (if (and prefix (looking-at prefix))
          (replace-match "" t t))
      (fixup-whitespace))))
Jim Blandy's avatar
Jim Blandy committed
660

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

Jim Blandy's avatar
Jim Blandy committed
663 664 665
(defun delete-blank-lines ()
  "On blank line, delete all surrounding blank lines, leaving just one.
On isolated blank line, delete that one.
666
On nonblank line, delete any immediately following blank lines."
Jim Blandy's avatar
Jim Blandy committed
667 668 669 670 671
  (interactive "*")
  (let (thisblank singleblank)
    (save-excursion
      (beginning-of-line)
      (setq thisblank (looking-at "[ \t]*$"))
Jim Blandy's avatar
Jim Blandy committed
672
      ;; Set singleblank if there is just one blank line here.
Jim Blandy's avatar
Jim Blandy committed
673 674 675 676 677 678
      (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
679
    ;; Delete preceding blank lines, and this one too if it's the only one.
Jim Blandy's avatar
Jim Blandy committed
680 681 682 683 684 685 686 687
    (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
688 689
    ;; Delete following blank lines, unless the current line is blank
    ;; and there are no following blank lines.
Jim Blandy's avatar
Jim Blandy committed
690 691 692 693 694 695 696
    (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
697 698 699 700 701
			   (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
702

703 704 705 706 707 708
(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
709
  :version "24.3")
710

711
(defun region-modifiable-p (start end)
Glenn Morris's avatar
Glenn Morris committed
712
  "Return non-nil if the region contains no read-only text."
713 714 715
  (and (not (get-text-property start 'read-only))
       (eq end (next-single-property-change start 'read-only nil end))))

716
(defun delete-trailing-whitespace (&optional start end)
717 718 719 720 721 722 723 724 725 726 727 728 729
  "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."
730 731 732 733 734
  (interactive (progn
                 (barf-if-buffer-read-only)
                 (if (use-region-p)
                     (list (region-beginning) (region-end))
                   (list nil nil))))
735 736
  (save-match-data
    (save-excursion
737
      (let ((end-marker (and end (copy-marker end))))
738 739
        (goto-char (or start (point-min)))
        (with-syntax-table (make-syntax-table (syntax-table))
740
          ;; Don't delete formfeeds, even if they are considered whitespace.
741
          (modify-syntax-entry ?\f "_")
742 743 744
          (while (re-search-forward "\\s-$" end-marker t)
            (skip-syntax-backward "-" (line-beginning-position))
            (let ((b (point)) (e (match-end 0)))
745 746 747
              (if (region-modifiable-p b e)
                  (delete-region b e)
                (goto-char e)))))
748 749 750 751 752 753 754
        (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)
755
               (region-modifiable-p (1+ (point)) (point-max))
756
               (delete-region (1+ (point)) (point-max)))))))
757 758
  ;; Return nil for the benefit of `write-file-functions'.
  nil)
759

760
(defun newline-and-indent (&optional arg)
Jim Blandy's avatar
Jim Blandy committed
761
  "Insert a newline, then indent according to major mode.
762
Indentation is done using the value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
763
In programming language modes, this is the same as TAB.
764
In some text modes, where TAB inserts a tab, this command indents to the
765 766 767 768
column specified by the function `current-left-margin'.

With ARG, perform this action that many times."
  (interactive "*p")
769
  (delete-horizontal-space t)
770 771 772 773 774
  (unless arg
    (setq arg 1))
  (dotimes (_ arg)
    (newline nil t)
    (indent-according-to-mode)))
Jim Blandy's avatar
Jim Blandy committed
775 776 777 778

(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,
779
which means calling the current value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
780 781
In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this indents to the
782
column specified by the function `current-left-margin'."
Jim Blandy's avatar
Jim Blandy committed
783
  (interactive "*")
784 785 786 787 788 789
  (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)
790 791 792 793 794 795 796 797 798 799
      ;; 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
800
      (delete-horizontal-space t))
801
    (indent-according-to-mode)))
802

803
(defcustom read-quoted-char-radix 8
804
  "Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
805 806 807 808 809 810 811 812 813 814 815 816 817 818 819
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."
820 821 822
  (let ((message-log-max nil)
	(help-events (delq nil (mapcar (lambda (c) (unless (characterp c) c))
				       help-event-list)))
823
	done (first t) (code 0) char translated)
824 825
    (while (not done)
      (let ((inhibit-quit first)
826 827
	    ;; Don't let C-h or other help chars get the help
	    ;; message--only help function keys.  See bug#16617.
828
	    (help-char nil)
829
	    (help-event-list help-events)
830 831 832 833 834
	    (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."))
835
	(setq char (read-event (and prompt (format "%s-" prompt)) t))
836
	(if inhibit-quit (setq quit-flag nil)))
837 838 839 840 841 842 843 844
      ;; 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)))
845 846 847 848
      (if (integerp translated)
	  (setq translated (char-resolve-modifiers translated)))
      (cond ((null translated))
	    ((not (integerp translated))
849
	     (setq unread-command-events (list char)
850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867
		   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)
868
	     (setq unread-command-events (list char)
869 870 871 872 873 874
		   done t))
	    (t (setq code translated
		     done t)))
      (setq first nil))
    code))

Karl Heuer's avatar
Karl Heuer committed
875 876 877
(defun quoted-insert (arg)
  "Read next input character and insert it.
This is useful for inserting control characters.
878
With argument, insert ARG copies of the character.
Jim Blandy's avatar
Jim Blandy committed
879

Karl Heuer's avatar
Karl Heuer committed
880 881 882 883 884 885
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.
886

Karl Heuer's avatar
Karl Heuer committed
887 888 889 890
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.
891

Karl Heuer's avatar
Karl Heuer committed
892 893 894 895
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")
896 897 898 899 900 901 902 903
  (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))))))
904 905 906 907 908 909 910 911
    ;; 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)))
912 913 914
    (unless (characterp char)
      (user-error "%s is not a valid character"
		  (key-description (vector char))))
Karl Heuer's avatar
Karl Heuer committed
915 916 917 918 919 920
    (if (> arg 0)
	(if (eq overwrite-mode 'overwrite-mode-binary)
	    (delete-char arg)))
    (while (> arg 0)
      (insert-and-inherit char)
      (setq arg (1- arg)))))
921

Kenichi Handa's avatar
Kenichi Handa committed
922
(defun forward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
923
  "Move forward ARG lines and position at first nonblank character."
924
  (interactive "^p")
Kenichi Handa's avatar
Kenichi Handa committed
925
  (forward-line (or arg 1))
Karl Heuer's avatar
Karl Heuer committed
926
  (skip-chars-forward " \t"))
927

Kenichi Handa's avatar
Kenichi Handa committed
928
(defun backward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
929
  "Move backward ARG lines and position at first nonblank character."
930
  (interactive "^p")
Kenichi Handa's avatar
Kenichi Handa committed
931
  (forward-line (- (or arg 1)))
Karl Heuer's avatar
Karl Heuer committed
932
  (skip-chars-forward " \t"))
Jim Blandy's avatar
Jim Blandy committed
933

Karl Heuer's avatar
Karl Heuer committed
934 935
(defun back-to-indentation ()
  "Move point to the first non-whitespace character on this line."
936
  (interactive "^")
Karl Heuer's avatar
Karl Heuer committed
937
  (beginning-of-line 1)
938
  (skip-syntax-forward " " (line-end-position))
939 940
  ;; Move back over chars that have whitespace syntax but have the p flag.
  (backward-prefix-chars))
Karl Heuer's avatar
Karl Heuer committed
941 942 943 944 945 946 947

(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)
948
    (if (or (looking-at "^\\|$\\|\\s)")
Karl Heuer's avatar
Karl Heuer committed
949 950 951
	    (save-excursion (forward-char -1)
			    (looking-at "$\\|\\s(\\|\\s'")))
	nil
952
      (insert ?\s))))
Karl Heuer's avatar
Karl Heuer committed
953

954 955
(defun delete-horizontal-space (&optional backward-only)
  "Delete all spaces and tabs around point.
956
If BACKWARD-ONLY is non-nil, only delete them before point."
957
  (interactive "*P")
958 959 960 961 962 963 964
  (let ((orig-pos (point)))
    (delete-region
     (if backward-only
	 orig-pos
       (progn
	 (skip-chars-forward " \t")
	 (constrain-to-field nil orig-pos t)))
965
     (progn
966 967
       (skip-chars-backward " \t")
       (constrain-to-field nil orig-pos)))))
Karl Heuer's avatar
Karl Heuer committed
968

969
(defun just-one-space (&optional n)
970
  "Delete all spaces and tabs around point, leaving one space (or N spaces).
Glenn Morris's avatar
Glenn Morris committed
971 972
If N is negative, delete newlines as well, leaving -N spaces.
See also `cycle-spacing'."
973
  (interactive "*p")
974
  (cycle-spacing n nil 'single-shot))
975 976 977

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

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

987 988 989 990 991
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.)
992

993
The second call in a sequence deletes all spaces.
994

995
The third call in a sequence restores the original whitespace (and point).
996

997 998 999 1000
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.
1001

1002 1003
Repeatedly calling the function with different values of N starts a
new sequence each time."
1004 1005 1006
  (interactive "*p")
  (let ((orig-pos	 (point))
	(skip-characters (if (and n (< n 0)) " \t\n\r" " \t"))
1007
	(num		 (abs (or n 1))))
1008
    (skip-chars-backward (if preserve-nl-back " \t" skip-characters))
1009
    (constrain-to-field nil orig-pos)
1010
    (cond
1011 1012
     ;; Command run for the first time, single-shot mode or different argument
     ((or (eq 'single-shot mode)
1013
	  (not (equal last-command this-command))
1014 1015
	  (not cycle-spacing--context)
	  (not (eq (car cycle-spacing--context) n)))
1016
      (let* ((start (point))
1017
	     (num   (- num (skip-chars-forward " " (+ num (point)))))
1018 1019 1020 1021 1022 1023 1024
	     (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)
1025
                (cons n (cons orig-pos (buffer-substring start (point))))))
1026
	;; If this run causes no change in buffer content, delete all spaces,
Paul Eggert's avatar
Paul Eggert committed
1027
	;; otherwise delete all excess spaces.
1028
	(delete-region (if (and (eq mode 'fast) (zerop num) (= mid end))
1029
			   start mid) end)
1030
        (insert (make-string num ?\s))))
1031 1032 1033 1034 1035 1036 1037

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

     ;; Command run for the third time.
     (t
1038 1039
      (insert (cddr cycle-spacing--context))
      (goto-char (cadr cycle-spacing--context))
1040
      (setq cycle-spacing--context nil)))))
1041

Jim Blandy's avatar
Jim Blandy committed
1042
(defun beginning-of-buffer (&optional arg)
1043
  "Move point to the beginning of the buffer.
1044
With numeric arg N, put point N/10 of the way from the beginning.
1045 1046
If the buffer is narrowed, this command uses the beginning of the
accessible part of the buffer.
1047

1048 1049
Push mark at previous position, unless either a \\[universal-argument] prefix
is supplied, or Transient Mark mode is enabled and the mark is active."
1050
  (declare (interactive-only "use `(goto-char (point-min))' instead."))
1051
  (interactive "^P")
1052
  (or (consp arg)
1053
      (region-active-p)
1054
      (push-mark))
1055
  (let ((size (- (point-max) (point-min))))
1056
    (goto-char (if (and arg (not (consp arg)))
1057 1058
		   (+ (point-min) 1
		      (/ (* size (prefix-numeric-value arg)) 10))