simple.el 338 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-2015 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 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
(defgroup killing nil
49
  "Killing and yanking commands."
50 51 52 53 54
  :group 'editing)

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

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

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

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

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

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

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

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

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

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

136 137 138 139 140 141 142 143
(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)

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

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

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

157
The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
158
that would normally be considered usable.  If it returns nil,
159 160 161 162 163 164 165 166 167 168 169 170 171 172
that buffer is rejected."
  (and (buffer-name buffer)		;First make sure it's live.
       (not (and avoid-current (eq buffer (current-buffer))))
       (with-current-buffer buffer
	 (if next-error-function   ; This is the normal test.
	     ;; Optionally reject some buffers.
	     (if extra-test-exclusive
		 (funcall extra-test-exclusive)
	       t)
	   ;; Optionally accept some other buffers.
	   (and extra-test-inclusive
		(funcall extra-test-inclusive))))))

(defun next-error-find-buffer (&optional avoid-current
173
					 extra-test-inclusive
174
					 extra-test-exclusive)
175
  "Return a `next-error' capable buffer.
176

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

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

184
The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
185 186
that would normally be considered usable.  If it returns nil,
that buffer is rejected."
187 188 189 190 191 192
  (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
193 194
				    (window-buffer w)
                                    avoid-current
195
                                    extra-test-inclusive extra-test-exclusive)
196 197 198 199
                                   (window-buffer w)))
                             (window-list))))))
     (if (eq (length window-buffers) 1)
         (car window-buffers)))
200
   ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
201
   (if (and next-error-last-buffer
202
            (next-error-buffer-p next-error-last-buffer avoid-current
203
                                 extra-test-inclusive extra-test-exclusive))
204 205 206 207
       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)
208
       (current-buffer))
209
   ;; 4. Look for any acceptable buffer.
210 211
   (let ((buffers (buffer-list)))
     (while (and buffers
212 213 214
                 (not (next-error-buffer-p
		       (car buffers) avoid-current
		       extra-test-inclusive extra-test-exclusive)))
215
       (setq buffers (cdr buffers)))
216 217 218 219 220 221 222
     (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
223
	  (message "This is the only buffer with error message locations")
224 225
	  (current-buffer)))
   ;; 6. Give up.
226
   (error "No buffers contain error message locations")))
227

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

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

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

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

\\[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
246 247 248 249
`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.
250

Juri Linkov's avatar
Juri Linkov committed
251 252 253 254
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.
255

256 257
To control which errors are matched, customize the variable
`compilation-error-regexp-alist'."
258
  (interactive "P")
259
  (if (consp arg) (setq reset t arg nil))
260 261 262
  (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
263
      (funcall next-error-function (prefix-numeric-value arg) reset)
264 265
      (when next-error-recenter
        (recenter next-error-recenter))
Juri Linkov's avatar
Juri Linkov committed
266
      (run-hooks 'next-error-hook))))
267

268 269 270 271 272 273
(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)
274 275
    (when next-error-recenter
      (recenter next-error-recenter))
276 277
    (run-hooks 'next-error-hook)))

278 279 280
(defalias 'goto-next-locus 'next-error)
(defalias 'next-match 'next-error)

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

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

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

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

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

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

Eli Zaretskii's avatar
Eli Zaretskii committed
322
(define-minor-mode next-error-follow-minor-mode
323
  "Minor mode for compilation, occur and diff modes.
324 325 326
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
327
When turned on, cursor motion in the compilation, grep, occur or diff
328
buffer causes automatic display of the corresponding source code location."
329
  :group 'next-error :init-value nil :lighter " Fol"
330
  (if (not next-error-follow-minor-mode)
331 332
      (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)
333
    (make-local-variable 'next-error-follow-last-line)))
334

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

346

347 348
;;;

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

356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376
;; 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
377 378
;; Making and deleting lines.

379 380 381 382 383 384 385
(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.")

386 387
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
  "Propertized string representing a hard newline character.")
388

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

395 396 397
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].
398 399

Calls `auto-fill-function' if the current column number is greater
400
than the value of `fill-column' and ARG is nil.
401
A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
402
  (interactive "*P\np")
403
  (barf-if-buffer-read-only)
404 405 406 407 408 409 410 411 412 413 414
  ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
  ;; Set last-command-event to tell self-insert what to insert.
  (let* ((was-page-start (and (bolp) (looking-at page-delimiter)))
         (beforepos (point))
         (last-command-event ?\n)
         ;; Don't auto-fill if we have a numeric argument.
         (auto-fill-function (if arg nil auto-fill-function))
         (postproc
          ;; Do the rest in post-self-insert-hook, because we want to do it
          ;; *before* other functions on that hook.
          (lambda ()
415
            (cl-assert (eq ?\n (char-before)))
416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433
            ;; Mark the newline(s) `hard'.
            (if use-hard-newlines
                (set-hard-newline-properties
                 (- (point) (prefix-numeric-value arg)) (point)))
            ;; If the newline leaves the previous line blank, and we
            ;; have a left margin, delete that from the blank line.
            (save-excursion
              (goto-char beforepos)
              (beginning-of-line)
              (and (looking-at "[ \t]$")
                   (> (current-left-margin) 0)
                   (delete-region (point)
                                  (line-end-position))))
            ;; Indent the line after the newline, except in one case:
            ;; when we added the newline at the beginning of a line which
            ;; starts a page.
            (or was-page-start
                (move-to-left-margin nil t)))))
434 435
    (unwind-protect
        (if (not interactive)
436 437 438 439
        ;; 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)))
440
          (self-insert-command (prefix-numeric-value arg)))
441 442
      (unwind-protect
          (progn
443
            (add-hook 'post-self-insert-hook postproc nil t)
444 445 446 447
            (self-insert-command (prefix-numeric-value arg)))
        ;; We first used let-binding to protect the hook, but that was naive
        ;; since add-hook affects the symbol-default value of the variable,
        ;; whereas the let-binding might only protect the buffer-local value.
448
        (remove-hook 'post-self-insert-hook postproc t)))
449 450
      (cl-assert (not (member postproc post-self-insert-hook)))
      (cl-assert (not (member postproc (default-value 'post-self-insert-hook))))))
451 452
  nil)

453 454 455 456 457 458 459
(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)))))
460

461 462
(declare-function electric-indent-just-newline "electric")
(defun open-line (n &optional interactive)
463
  "Insert a newline and leave point before it.
464 465
If `electric-indent-mode' is enabled, indent the new line if it's
not empty.
466 467 468
If there is a fill prefix and/or a `left-margin', insert them on
the new line.  If the old line would have been blank, insert them
on the old line as well.
469 470 471 472

With arg N, insert N newlines.
A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
  (interactive "*p\np")
473
  (let* ((do-fill-prefix (and fill-prefix (bolp)))
474
	 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
475
	 (loc (point-marker))
476
         ;; Don't expand an abbrev before point.
477
	 (abbrev-mode nil))
478 479 480 481
    (if (and interactive
             (looking-at-p "[[:space:]]*$"))
        (electric-indent-just-newline n)
      (newline n interactive))
482
    (goto-char loc)
483
    (while (> n 0)
484 485 486 487
      (cond ((bolp)
	     (if do-left-margin (indent-to (current-left-margin)))
	     (if do-fill-prefix (insert-and-inherit fill-prefix))))
      (forward-line 1)
488
      (setq n (1- n)))
489
    (goto-char loc)
490
    ;; Necessary in case a margin or prefix was inserted.
491
    (end-of-line)))
Jim Blandy's avatar
Jim Blandy committed
492

493 494 495
(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
496
line as well.  With prefix ARG, don't insert `fill-prefix' on new line.
497

498
When called from Lisp code, ARG may be a prefix string to copy."
499
  (interactive "*P")
Jim Blandy's avatar
Jim Blandy committed
500
  (skip-chars-forward " \t")
501 502 503 504 505 506 507 508 509 510 511
  (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))))))
512
    (newline 1)
513
    (if have-prfx (insert-and-inherit prefix))
Jim Blandy's avatar
Jim Blandy committed
514 515 516 517 518
    (indent-to col 0)
    (goto-char pos)))

(defun delete-indentation (&optional arg)
  "Join this line to previous and fix up whitespace at join.
519
If there is a fill prefix, delete it from the beginning of this line.
Jim Blandy's avatar
Jim Blandy committed
520 521 522 523 524 525 526
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)))
527 528 529
	;; If the second line started with the fill prefix,
	;; delete the prefix.
	(if (and fill-prefix
530
		 (<= (+ (point) (length fill-prefix)) (point-max))
531 532 533 534
		 (string= fill-prefix
			  (buffer-substring (point)
					    (+ (point) (length fill-prefix)))))
	    (delete-region (point) (+ (point) (length fill-prefix))))
Jim Blandy's avatar
Jim Blandy committed
535 536
	(fixup-whitespace))))

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

Jim Blandy's avatar
Jim Blandy committed
539 540 541
(defun delete-blank-lines ()
  "On blank line, delete all surrounding blank lines, leaving just one.
On isolated blank line, delete that one.
542
On nonblank line, delete any immediately following blank lines."
Jim Blandy's avatar
Jim Blandy committed
543 544 545 546 547
  (interactive "*")
  (let (thisblank singleblank)
    (save-excursion
      (beginning-of-line)
      (setq thisblank (looking-at "[ \t]*$"))
Jim Blandy's avatar
Jim Blandy committed
548
      ;; Set singleblank if there is just one blank line here.
Jim Blandy's avatar
Jim Blandy committed
549 550 551 552 553 554
      (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
555
    ;; Delete preceding blank lines, and this one too if it's the only one.
Jim Blandy's avatar
Jim Blandy committed
556 557 558 559 560 561 562 563
    (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
564 565
    ;; Delete following blank lines, unless the current line is blank
    ;; and there are no following blank lines.
Jim Blandy's avatar
Jim Blandy committed
566 567 568 569 570 571 572
    (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
573 574 575 576 577
			   (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
578

579 580 581 582 583 584
(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
585
  :version "24.3")
586

587
(defun delete-trailing-whitespace (&optional start end)
588 589 590 591 592 593 594 595 596 597 598 599 600
  "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."
601 602 603 604 605
  (interactive (progn
                 (barf-if-buffer-read-only)
                 (if (use-region-p)
                     (list (region-beginning) (region-end))
                   (list nil nil))))
606 607
  (save-match-data
    (save-excursion
608 609 610 611
      (let ((end-marker (copy-marker (or end (point-max))))
            (start (or start (point-min))))
        (goto-char start)
        (while (re-search-forward "\\s-$" end-marker t)
612 613
          (save-match-data
            (skip-syntax-backward "-" (line-beginning-position)))
614
          ;; Don't delete formfeeds, even if they are considered whitespace.
615 616
          (if (looking-at-p ".*\f")
              (goto-char (match-end 0)))
617
          (delete-region (point) (match-end 0)))
618 619 620
        ;; Delete trailing empty lines.
        (goto-char end-marker)
        (when (and (not end)
621
		   delete-trailing-lines
622
                   ;; Really the end of buffer.
623
		   (= (point-max) (1+ (buffer-size)))
624
                   (<= (skip-chars-backward "\n") -2))
625
          (delete-region (1+ (point)) end-marker))
626 627 628
        (set-marker end-marker nil))))
  ;; Return nil for the benefit of `write-file-functions'.
  nil)
629

Jim Blandy's avatar
Jim Blandy committed
630 631
(defun newline-and-indent ()
  "Insert a newline, then indent according to major mode.
632
Indentation is done using the value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
633
In programming language modes, this is the same as TAB.
634
In some text modes, where TAB inserts a tab, this command indents to the
635
column specified by the function `current-left-margin'."
Jim Blandy's avatar
Jim Blandy committed
636
  (interactive "*")
637
  (delete-horizontal-space t)
638
  (newline nil t)
Jim Blandy's avatar
Jim Blandy committed
639 640 641 642 643
  (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,
644
which means calling the current value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
645 646
In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this indents to the
647
column specified by the function `current-left-margin'."
Jim Blandy's avatar
Jim Blandy committed
648
  (interactive "*")
649 650 651 652 653 654
  (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)
655 656 657 658 659 660 661 662 663 664
      ;; 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
665
      (delete-horizontal-space t))
666
    (indent-according-to-mode)))
667

668
(defcustom read-quoted-char-radix 8
669
  "Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
670 671 672 673 674 675 676 677 678 679 680 681 682 683 684
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."
685 686 687 688
  (let ((message-log-max nil)
	(help-events (delq nil (mapcar (lambda (c) (unless (characterp c) c))
				       help-event-list)))
	done (first t) (code 0) translated)
689 690
    (while (not done)
      (let ((inhibit-quit first)
691 692
	    ;; Don't let C-h or other help chars get the help
	    ;; message--only help function keys.  See bug#16617.
693
	    (help-char nil)
694
	    (help-event-list help-events)
695 696 697 698 699 700 701 702 703 704 705 706
	    (help-form
	     "Type the special character you want to use,
or the octal character code.
RET terminates the character code and is discarded;
any other non-digit terminates the character code and is then used as input."))
	(setq translated (read-key (and prompt (format "%s-" prompt))))
	(if inhibit-quit (setq quit-flag nil)))
      (if (integerp translated)
	  (setq translated (char-resolve-modifiers translated)))
      (cond ((null translated))
	    ((not (integerp translated))
	     (setq unread-command-events
707 708
                   (nconc (listify-key-sequence (this-single-command-raw-keys))
                          unread-command-events)
709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727
		   done t))
	    ((/= (logand translated ?\M-\^@) 0)
	     ;; Turn a meta-character into a character with the 0200 bit set.
	     (setq code (logior (logand translated (lognot ?\M-\^@)) 128)
		   done t))
	    ((and (<= ?0 translated)
                  (< translated (+ ?0 (min 10 read-quoted-char-radix))))
	     (setq code (+ (* code read-quoted-char-radix) (- translated ?0)))
	     (and prompt (setq prompt (message "%s %c" prompt translated))))
	    ((and (<= ?a (downcase translated))
		  (< (downcase translated)
                     (+ ?a -10 (min 36 read-quoted-char-radix))))
	     (setq code (+ (* code read-quoted-char-radix)
			   (+ 10 (- (downcase translated) ?a))))
	     (and prompt (setq prompt (message "%s %c" prompt translated))))
	    ((and (not first) (eq translated ?\C-m))
	     (setq done t))
	    ((not first)
	     (setq unread-command-events
728 729
                   (nconc (listify-key-sequence (this-single-command-raw-keys))
                          unread-command-events)
730 731 732 733 734 735
		   done t))
	    (t (setq code translated
		     done t)))
      (setq first nil))
    code))

Karl Heuer's avatar
Karl Heuer committed
736 737 738
(defun quoted-insert (arg)
  "Read next input character and insert it.
This is useful for inserting control characters.
739
With argument, insert ARG copies of the character.
Jim Blandy's avatar
Jim Blandy committed
740

Karl Heuer's avatar
Karl Heuer committed
741 742 743 744 745 746
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.
747

Karl Heuer's avatar
Karl Heuer committed
748 749 750 751
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.
752

Karl Heuer's avatar
Karl Heuer committed
753 754 755 756
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")
757 758 759 760 761 762 763 764
  (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))))))
765 766 767 768 769 770 771 772
    ;; 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)))
773 774 775
    (unless (characterp char)
      (user-error "%s is not a valid character"
		  (key-description (vector char))))
Karl Heuer's avatar
Karl Heuer committed
776 777 778 779 780 781
    (if (> arg 0)
	(if (eq overwrite-mode 'overwrite-mode-binary)
	    (delete-char arg)))
    (while (> arg 0)
      (insert-and-inherit char)
      (setq arg (1- arg)))))
782

Kenichi Handa's avatar
Kenichi Handa committed
783
(defun forward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
784
  "Move forward ARG lines and position at first nonblank character."
785
  (interactive "^p")
Kenichi Handa's avatar
Kenichi Handa committed
786
  (forward-line (or arg 1))
Karl Heuer's avatar
Karl Heuer committed
787
  (skip-chars-forward " \t"))
788

Kenichi Handa's avatar
Kenichi Handa committed
789
(defun backward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
790
  "Move backward ARG lines and position at first nonblank character."
791
  (interactive "^p")
Kenichi Handa's avatar
Kenichi Handa committed
792
  (forward-line (- (or arg 1)))
Karl Heuer's avatar
Karl Heuer committed
793
  (skip-chars-forward " \t"))
Jim Blandy's avatar
Jim Blandy committed
794

Karl Heuer's avatar
Karl Heuer committed
795 796
(defun back-to-indentation ()
  "Move point to the first non-whitespace character on this line."
797
  (interactive "^")
Karl Heuer's avatar
Karl Heuer committed
798
  (beginning-of-line 1)
799
  (skip-syntax-forward " " (line-end-position))
800 801
  ;; Move back over chars that have whitespace syntax but have the p flag.
  (backward-prefix-chars))
Karl Heuer's avatar
Karl Heuer committed
802 803 804 805 806 807 808 809 810 811 812

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

815 816
(defun delete-horizontal-space (&optional backward-only)
  "Delete all spaces and tabs around point.
817
If BACKWARD-ONLY is non-nil, only delete them before point."
818
  (interactive "*P")
819 820 821 822 823 824 825
  (let ((orig-pos (point)))
    (delete-region
     (if backward-only
	 orig-pos
       (progn
	 (skip-chars-forward " \t")
	 (constrain-to-field nil orig-pos t)))
826
     (progn
827 828
       (skip-chars-backward " \t")
       (constrain-to-field nil orig-pos)))))
Karl Heuer's avatar
Karl Heuer committed
829

830
(defun just-one-space (&optional n)
831
  "Delete all spaces and tabs around point, leaving one space (or N spaces).
Glenn Morris's avatar
Glenn Morris committed
832 833
If N is negative, delete newlines as well, leaving -N spaces.
See also `cycle-spacing'."
834
  (interactive "*p")
835
  (cycle-spacing n nil 'single-shot))
836 837 838

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

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

848 849 850 851 852
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.)
853

854
The second call in a sequence deletes all spaces.
855

856
The third call in a sequence restores the original whitespace (and point).
857

858 859 860 861
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.
862

863 864
Repeatedly calling the function with different values of N starts a
new sequence each time."
865 866 867
  (interactive "*p")
  (let ((orig-pos	 (point))
	(skip-characters (if (and n (< n 0)) " \t\n\r" " \t"))
868
	(num		 (abs (or n 1))))
869
    (skip-chars-backward (if preserve-nl-back " \t" skip-characters))
870
    (constrain-to-field nil orig-pos)
871
    (cond
872 873
     ;; Command run for the first time, single-shot mode or different argument
     ((or (eq 'single-shot mode)
874
	  (not (equal last-command this-command))
875 876
	  (not cycle-spacing--context)
	  (not (eq (car cycle-spacing--context) n)))
877
      (let* ((start (point))
878
	     (num   (- num (skip-chars-forward " " (+ num (point)))))
879 880 881 882 883 884 885
	     (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)
886
                (cons n (cons orig-pos (buffer-substring start (point))))))
887
	;; If this run causes no change in buffer content, delete all spaces,
Paul Eggert's avatar
Paul Eggert committed
888
	;; otherwise delete all excess spaces.
889
	(delete-region (if (and (eq mode 'fast) (zerop num) (= mid end))
890
			   start mid) end)
891
        (insert (make-string num ?\s))))
892 893 894 895 896 897 898

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

     ;; Command run for the third time.
     (t
899 900
      (insert (cddr cycle-spacing--context))
      (goto-char (cadr cycle-spacing--context))
901
      (setq cycle-spacing--context nil)))))
902

Jim Blandy's avatar
Jim Blandy committed
903
(defun beginning-of-buffer (&optional arg)
904
  "Move point to the beginning of the buffer.
905
With numeric arg N, put point N/10 of the way from the beginning.
906 907
If the buffer is narrowed, this command uses the beginning of the
accessible part of the buffer.
908

909
If Transient Mark mode is disabled, leave mark at previous
910
position, unless a \\[universal-argument] prefix is supplied."
911
  (declare (interactive-only "use `(goto-char (point-min))' instead."))
912
  (interactive "^P")
913
  (or (consp arg)
914
      (region-active-p)
915
      (push-mark))
916
  (let ((size (- (point-max) (point-min))))
917
    (goto-char (if (and arg (not (consp arg)))
918 919 920 921 922 923 924
		   (+ (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))))
925
  (if (and arg (not (consp arg))) (forward-line 1)))
Jim Blandy's avatar
Jim Blandy committed
926 927

(defun end-of-buffer (&optional arg)
928
  "Move point to the end of the buffer.
929
With numeric arg N, put point N/10 of the way from the end.
930 931
If the buffer is narrowed, this command uses the end of the
accessible part of the buffer.
932

933
If Transient Mark mode is disabled, leave mark at previous
934
position, unless a \\[universal-argument] prefix is supplied."
935
  (declare (interactive-only "use `(goto-char (point-max))' instead."))
936
  (interactive "^P")
937
  (or (consp arg) (region-active-p) (push-mark))
938
  (let ((size (- (point-max) (point-min))))
939
    (goto-char (if (and arg (not (consp arg)))
940 941 942 943 944 945 946
		   (- (point-max)
		      (if (> size 10000)
			  ;; Avoid overflow for large buffer sizes!
			  (* (prefix-numeric-value arg)
			     (/ size 10))
			(/ (* size (prefix-numeric-value arg)) 10)))
		 (point-max))))
Eric S. Raymond's avatar
Eric S. Raymond committed
947 948
  ;; If we went to a place in the middle of the buffer,
  ;; adjust it to the beginning of a line.
949
  (cond ((and arg (not (consp arg))) (forward-line 1))
950 951
	((and (eq (current-buffer) (window-buffer))
              (> (point) (window-end nil t)))
952 953 954 955
	 ;; If the end of the buffer is not already on the screen,
	 ;; then scroll specially to put it near, but not at, the bottom.
	 (overlay-recenter (point))
	 (recenter -3))))
Jim Blandy's avatar
Jim Blandy committed
956

957 958 959 960 961 962 963 964 965 966 967
(defcustom delete-active-region t
  "Whether single-char deletion commands delete an active region.
This has an effect only if Transient Mark mode is enabled, and
affects `delete-forward-char' and `delete-backward-char', though
not `delete-char'.

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

971 972 973 974 975 976 977 978 979 980 981 982
(defvar region-extract-function
  (lambda (delete)
    (when (region-beginning)
      (if (eq delete 'delete-only)
          (delete-region (region-beginning) (region-end))
        (filter-buffer-substring (region-beginning) (region-end) delete))))
  "Function to get the region's content.
Called with one argument DELETE.
If DELETE is `delete-only', then only delete the region and the return value
is undefined.  If DELETE is nil, just return the content as a string.
If anything else, delete the region and return its content as a string.")

983 984 985 986
(defun delete-backward-char (n &optional killflag)
  "Delete the previous N characters (following if N is negative).
If Transient Mark mode is enabled, the mark is active, and N is 1,
delete the text in the region and deactivate the mark instead.
987
To disable this, set option `delete-active-region' to nil.
988 989 990 991 992 993 994 995

Optional second arg KILLFLAG, if non-nil, means to kill (save in
kill ring) instead of delete.  Interactively, N is the prefix
arg, and KILLFLAG is set if N is explicitly specified.

In Overwrite mode, single character backward deletion may replace
tabs with spaces so as to back over columns, unless point is at
the end of the line."
996
  (declare (interactive-only delete-char))
997 998 999 1000 1001 1002 1003 1004
  (interactive "p\nP")
  (unless (integerp n)
    (signal 'wrong-type-argument (list 'integerp n)))
  (cond ((and (use-region-p)
	      delete-active-region
	      (= n 1))
	 ;; If a region is active, kill or delete it.
	 (if (eq delete-active-region 'kill)
1005 1006
	     (kill-region (region-beginning) (region-end) 'region)
           (funcall region-extract-function 'delete-only)))
1007 1008 1009 1010 1011 1012
	;; In Overwrite mode, maybe untabify while deleting
	((null (or (null overwrite-mode)
		   (<= n 0)
		   (memq (char-before) '(?\t ?\n))
		   (eobp)
		   (eq (char-after) ?\n)))
1013 1014
	 (let ((ocol (current-column)))
           (delete-char (- n) killflag)
1015 1016 1017 1018 1019 1020
	   (save-excursion
	     (insert-char ?\s (- ocol (current-column)) nil))))
	;; Otherwise, do simple deletion.
	(t (delete-char (- n) killflag))))

(defun delete-forward-char (n &optional killflag)
1021
  "Delete the following N characters (previous if N is negative).
1022 1023
If Transient Mark mode is enabled, the mark is active, and N is 1,
delete the text in the region and deactivate the mark instead.
1024
To disable this, set variable `delete-active-region' to nil.
1025 1026 1027 1028

Optional second arg KILLFLAG non-nil means to kill (save in kill
ring) instead of delete.  Interactively, N is the prefix arg, and
KILLFLAG is set if N was explicitly specified."
1029
  (declare (interactive-only delete-char))
1030 1031 1032 1033 1034 1035 1036 1037
  (interactive "p\nP")
  (unless (integerp n)
    (signal 'wrong-type-argument (list 'integerp n)))
  (cond ((and (use-region-p)
	      delete-active-region
	      (= n 1))
	 ;; If a region is active, kill or delete it.
	 (if (eq delete-active-region 'kill)
1038 1039 1040
	     (kill-region (region-beginning) (region-end) 'region)
	   (funcall region-extract-function 'delete-only)))

1041 1042 1043
	;; Otherwise, do simple deletion.
	(t (delete-char n killflag))))

Jim Blandy's avatar
Jim Blandy committed
1044
(defun mark-whole-buffer ()
Jim Blandy's avatar
Jim Blandy committed
1045
  "Put point at beginning and mark at end of buffer.
1046
If narrowing is in effect, only uses the accessible part of the buffer.
Jim Blandy's avatar
Jim Blandy committed
1047 1048 1049
You probably should not use this function in Lisp programs;
it is usually a mistake for a Lisp function to use any subroutine
that uses or sets the mark."
1050
  (declare (interactive-only t))
Jim Blandy's avatar
Jim Blandy committed
1051 1052
  (interactive)
  (push-mark (point))