simple.el 263 KB
Newer Older
Eric S. Raymond's avatar
Eric S. Raymond committed
1 2
;;; simple.el --- basic editing commands for Emacs

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

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

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

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

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
22
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Jim Blandy's avatar
Jim Blandy committed
23

24 25 26 27 28
;;; Commentary:

;; A grab-bag of basic Emacs commands not specifically related to some
;; major mode or to file-handling.

Eric S. Raymond's avatar
Eric S. Raymond committed
29
;;; Code:
Jim Blandy's avatar
Jim Blandy committed
30

31 32 33
;; This is for lexical-let in apply-partially.
(eval-when-compile (require 'cl))

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

37 38
(defvar compilation-current-error)

39
(defcustom idle-update-delay 0.5
40
  "Idle time delay before updating various things on the screen.
41 42 43 44 45
Various Emacs features that update auxiliary information when point moves
wait this many seconds after Emacs becomes idle before doing an update."
  :type 'number
  :group 'display
  :version "22.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
46

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

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

55 56
(defun get-next-valid-buffer (list &optional buffer visible-ok frame)
  "Search LIST for a valid buffer to display in FRAME.
57 58 59 60 61 62
Return nil when all buffers in LIST are undesirable for display,
otherwise return the first suitable buffer in LIST.

Buffers not visible in windows are preferred to visible buffers,
unless VISIBLE-OK is non-nil.
If the optional argument FRAME is nil, it defaults to the selected frame.
63
If BUFFER is non-nil, ignore occurrences of that buffer in LIST."
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
  ;; This logic is more or less copied from other-buffer.
  (setq frame (or frame (selected-frame)))
  (let ((pred (frame-parameter frame 'buffer-predicate))
	found buf)
    (while (and (not found) list)
      (setq buf (car list))
      (if (and (not (eq buffer buf))
	       (buffer-live-p buf)
	       (or (null pred) (funcall pred buf))
	       (not (eq (aref (buffer-name buf) 0) ?\s))
	       (or visible-ok (null (get-buffer-window buf 'visible))))
	  (setq found buf)
	(setq list (cdr list))))
    (car list)))

79
(defun last-buffer (&optional buffer visible-ok frame)
80 81
  "Return the last buffer in FRAME's buffer list.
If BUFFER is the last buffer, return the preceding buffer instead.
82 83
Buffers not visible in windows are preferred to visible buffers,
unless optional argument VISIBLE-OK is non-nil.
84 85 86 87
Optional third argument FRAME nil or omitted means use the
selected frame's buffer list.
If no such buffer exists, return the buffer `*scratch*', creating
it if necessary."
88
  (setq frame (or frame (selected-frame)))
89 90
  (or (get-next-valid-buffer (nreverse (buffer-list frame))
 			     buffer visible-ok frame)
91 92 93 94 95
      (get-buffer "*scratch*")
      (let ((scratch (get-buffer-create "*scratch*")))
	(set-buffer-major-mode scratch)
	scratch)))

96 97 98
(defun next-buffer ()
  "Switch to the next buffer in cyclic order."
  (interactive)
99
  (let ((buffer (current-buffer)))
100
    (switch-to-buffer (other-buffer buffer t))
101
    (bury-buffer buffer)))
102 103

(defun previous-buffer ()
104 105
  "Switch to the previous buffer in cyclic order."
  (interactive)
106
  (switch-to-buffer (last-buffer (current-buffer) t)))
107

108

109
;;; next-error support framework
110 111

(defgroup next-error nil
112
  "`next-error' support framework."
113
  :group 'compilation
114
  :version "22.1")
115 116 117 118 119

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

122
(defcustom next-error-highlight 0.5
123
  "Highlighting of locations in selected source buffers.
124 125 126 127
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.
128 129
If nil, don't highlight the locus in the source buffer.
If `fringe-arrow', indicate the locus by the fringe arrow."
130
  :type '(choice (number :tag "Highlight for specified time")
131
                 (const :tag "Semipermanent highlighting" t)
132
                 (const :tag "No highlighting" nil)
133
                 (const :tag "Fringe arrow" fringe-arrow))
134
  :group 'next-error
135
  :version "22.1")
136

137
(defcustom next-error-highlight-no-select 0.5
138
  "Highlighting of locations in `next-error-no-select'.
139
If number, highlight the locus in `next-error' face for given time in seconds.
140
If t, highlight the locus indefinitely until some other locus replaces it.
141 142
If nil, don't highlight the locus in the source buffer.
If `fringe-arrow', indicate the locus by the fringe arrow."
143
  :type '(choice (number :tag "Highlight for specified time")
144
                 (const :tag "Semipermanent highlighting" t)
145
                 (const :tag "No highlighting" nil)
146
                 (const :tag "Fringe arrow" fringe-arrow))
147
  :group 'next-error
148
  :version "22.1")
149

150
(defcustom next-error-recenter nil
151
  "Display the line in the visited source file recentered as specified.
152 153 154
If non-nil, the value is passed directly to `recenter'."
  :type '(choice (integer :tag "Line to recenter to")
                 (const :tag "Center of window" (4))
155 156 157 158
                 (const :tag "No recentering" nil))
  :group 'next-error
  :version "23.1")

Juri Linkov's avatar
Juri Linkov committed
159
(defcustom next-error-hook nil
160
  "List of hook functions run by `next-error' after visiting source file."
Juri Linkov's avatar
Juri Linkov committed
161 162 163
  :type 'hook
  :group 'next-error)

164 165
(defvar next-error-highlight-timer nil)

166
(defvar next-error-overlay-arrow-position nil)
167
(put 'next-error-overlay-arrow-position 'overlay-arrow-string (purecopy "=>"))
168 169
(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)

170
(defvar next-error-last-buffer nil
171
  "The most recent `next-error' buffer.
172 173 174 175 176
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
177 178 179 180 181 182 183 184
  "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.")
185 186
(make-variable-buffer-local 'next-error-function)

187 188 189 190 191 192 193 194
(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)

195
(defsubst next-error-buffer-p (buffer
196
			       &optional avoid-current
197
			       extra-test-inclusive
198
			       extra-test-exclusive)
199
  "Test if BUFFER is a `next-error' capable buffer.
200 201 202 203 204 205 206 207

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.

208
The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
209
that would normally be considered usable.  If it returns nil,
210 211 212 213 214 215 216 217 218 219 220 221 222 223
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
224
					 extra-test-inclusive
225
					 extra-test-exclusive)
226
  "Return a `next-error' capable buffer.
227

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

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

235
The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
236 237
that would normally be considered usable.  If it returns nil,
that buffer is rejected."
238 239 240 241 242 243
  (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
244 245
				    (window-buffer w)
                                    avoid-current
246
                                    extra-test-inclusive extra-test-exclusive)
247 248 249 250
                                   (window-buffer w)))
                             (window-list))))))
     (if (eq (length window-buffers) 1)
         (car window-buffers)))
251
   ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
252
   (if (and next-error-last-buffer
253
            (next-error-buffer-p next-error-last-buffer avoid-current
254
                                 extra-test-inclusive extra-test-exclusive))
255 256 257 258
       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)
259
       (current-buffer))
260
   ;; 4. Look for any acceptable buffer.
261 262
   (let ((buffers (buffer-list)))
     (while (and buffers
263 264 265
                 (not (next-error-buffer-p
		       (car buffers) avoid-current
		       extra-test-inclusive extra-test-exclusive)))
266
       (setq buffers (cdr buffers)))
267 268 269 270 271 272 273
     (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
274
	  (message "This is the only buffer with error message locations")
275 276
	  (current-buffer)))
   ;; 6. Give up.
277
   (error "No buffers contain error message locations")))
278

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

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

285
A prefix ARG specifies how many error messages to move;
286 287 288 289
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.

290
The RESET argument specifies that we should restart from the beginning.
291 292 293 294 295 296

\\[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
297 298 299 300
`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.
301

Juri Linkov's avatar
Juri Linkov committed
302 303 304 305
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.
306

307 308
To control which errors are matched, customize the variable
`compilation-error-regexp-alist'."
309
  (interactive "P")
310
  (if (consp arg) (setq reset t arg nil))
311 312 313
  (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
314
      (funcall next-error-function (prefix-numeric-value arg) reset)
315 316
      (when next-error-recenter
        (recenter next-error-recenter))
Juri Linkov's avatar
Juri Linkov committed
317
      (run-hooks 'next-error-hook))))
318

319 320 321 322 323 324
(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)
325 326
    (when next-error-recenter
      (recenter next-error-recenter))
327 328
    (run-hooks 'next-error-hook)))

329 330 331
(defalias 'goto-next-locus 'next-error)
(defalias 'next-match 'next-error)

332
(defun previous-error (&optional n)
333
  "Visit previous `next-error' message and corresponding source code.
334 335 336 337 338 339

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

342
(defun first-error (&optional n)
343 344 345 346 347 348 349
  "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))

350
(defun next-error-no-select (&optional n)
351
  "Move point to the next error in the `next-error' buffer and highlight match.
352 353 354 355 356
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")
357 358
  (let ((next-error-highlight next-error-highlight-no-select))
    (next-error n))
359 360
  (pop-to-buffer next-error-last-buffer))

361
(defun previous-error-no-select (&optional n)
362
  "Move point to the previous error in the `next-error' buffer and highlight match.
363 364 365 366 367
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")
368
  (next-error-no-select (- (or n 1))))
369

370
;; Internal variable for `next-error-follow-mode-post-command-hook'.
371 372
(defvar next-error-follow-last-line nil)

Eli Zaretskii's avatar
Eli Zaretskii committed
373
(define-minor-mode next-error-follow-minor-mode
374
  "Minor mode for compilation, occur and diff modes.
Eli Zaretskii's avatar
Eli Zaretskii committed
375 376 377
When turned on, cursor motion in the compilation, grep, occur or diff
buffer causes automatic display of the corresponding source code
location."
378
  :group 'next-error :init-value nil :lighter " Fol"
379
  (if (not next-error-follow-minor-mode)
380 381
      (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)
382
    (make-local-variable 'next-error-follow-last-line)))
383

384 385
;; Used as a `post-command-hook' by `next-error-follow-mode'
;; for the *Compilation* *grep* and *Occur* buffers.
386 387 388 389 390 391 392 393 394
(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))))

395

396 397
;;;

Karl Heuer's avatar
Karl Heuer committed
398 399 400 401
(defun fundamental-mode ()
  "Major mode not specialized for anything in particular.
Other major modes are defined by comparison with this one."
  (interactive)
402
  (kill-all-local-variables)
403
  (run-mode-hooks 'fundamental-mode-hook))
404

Stefan Monnier's avatar
Stefan Monnier committed
405 406 407 408 409 410 411 412 413
;; 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)
    (define-key map "\C-?" 'scroll-down)
    (define-key map "?" 'describe-mode)
414
    (define-key map "h" 'describe-mode)
Stefan Monnier's avatar
Stefan Monnier committed
415 416 417
    (define-key map ">" 'end-of-buffer)
    (define-key map "<" 'beginning-of-buffer)
    (define-key map "g" 'revert-buffer)
418
    (define-key map "z" 'kill-this-buffer)
Stefan Monnier's avatar
Stefan Monnier committed
419
    map))
420

Stefan Monnier's avatar
Stefan Monnier committed
421 422 423 424 425
(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))

426 427
;; Major mode meant to be the parent of programming modes.

428 429 430 431 432 433 434 435 436 437 438 439 440
(defvar prog-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [?\C-\M-q] 'prog-indent-sexp)
    map)
  "Keymap used for programming modes.")

(defun prog-indent-sexp ()
  "Indent the expression after point."
  (interactive)
  (let ((start (point))
        (end (save-excursion (forward-sexp 1) (point))))
    (indent-region start end nil)))

441 442 443
(define-derived-mode prog-mode fundamental-mode "Prog"
  "Major mode for editing programming language source code."
  (set (make-local-variable 'require-final-newline) mode-require-final-newline)
444 445 446
  (set (make-local-variable 'parse-sexp-ignore-comments) t)
  ;; Any programming language is always written left to right.
  (setq bidi-paragraph-direction 'left-to-right))
447

Karl Heuer's avatar
Karl Heuer committed
448 449
;; Making and deleting lines.

450 451
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
  "Propertized string representing a hard newline character.")
452

453
(defun newline (&optional arg)
454
  "Insert a newline, and move to left margin of the new line if it's blank.
Dave Love's avatar
Dave Love committed
455 456
If `use-hard-newlines' is non-nil, the newline is marked with the
text-property `hard'.
457
With ARG, insert that many newlines.
Dave Love's avatar
Dave Love committed
458
Call `auto-fill-function' if the current column number is greater
459
than the value of `fill-column' and ARG is nil."
460
  (interactive "*P")
461
  (barf-if-buffer-read-only)
462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498
  ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
  ;; Set last-command-event to tell self-insert what to insert.
  (let* ((was-page-start (and (bolp) (looking-at page-delimiter)))
         (beforepos (point))
         (last-command-event ?\n)
         ;; Don't auto-fill if we have a numeric argument.
         (auto-fill-function (if arg nil auto-fill-function))
         (postproc
          ;; Do the rest in post-self-insert-hook, because we want to do it
          ;; *before* other functions on that hook.
          (lambda ()
            ;; Mark the newline(s) `hard'.
            (if use-hard-newlines
                (set-hard-newline-properties
                 (- (point) (prefix-numeric-value arg)) (point)))
            ;; If the newline leaves the previous line blank, and we
            ;; have a left margin, delete that from the blank line.
            (save-excursion
              (goto-char beforepos)
              (beginning-of-line)
              (and (looking-at "[ \t]$")
                   (> (current-left-margin) 0)
                   (delete-region (point)
                                  (line-end-position))))
            ;; Indent the line after the newline, except in one case:
            ;; when we added the newline at the beginning of a line which
            ;; starts a page.
            (or was-page-start
                (move-to-left-margin nil t)))))
    (unwind-protect
        (progn
          (add-hook 'post-self-insert-hook postproc)
          (self-insert-command (prefix-numeric-value arg)))
      ;; We first used let-binding to protect the hook, but that was naive
      ;; since add-hook affects the symbol-default value of the variable,
      ;; whereas the let-binding might only protect the buffer-local value.
      (remove-hook 'post-self-insert-hook postproc)))
499 500
  nil)

501 502 503 504 505 506 507
(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)))))
508

509
(defun open-line (n)
510
  "Insert a newline and leave point before it.
511 512
If there is a fill prefix and/or a `left-margin', insert them
on the new line if the line would have been blank.
513
With arg N, insert N newlines."
Jim Blandy's avatar
Jim Blandy committed
514
  (interactive "*p")
515
  (let* ((do-fill-prefix (and fill-prefix (bolp)))
516
	 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
517
	 (loc (point-marker))
518 519
	 ;; Don't expand an abbrev before point.
	 (abbrev-mode nil))
520
    (newline n)
521
    (goto-char loc)
522
    (while (> n 0)
523 524 525 526
      (cond ((bolp)
	     (if do-left-margin (indent-to (current-left-margin)))
	     (if do-fill-prefix (insert-and-inherit fill-prefix))))
      (forward-line 1)
527
      (setq n (1- n)))
528 529
    (goto-char loc)
    (end-of-line)))
Jim Blandy's avatar
Jim Blandy committed
530

531 532 533
(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
534
line as well.  With prefix ARG, don't insert `fill-prefix' on new line.
535

536
When called from Lisp code, ARG may be a prefix string to copy."
537
  (interactive "*P")
Jim Blandy's avatar
Jim Blandy committed
538
  (skip-chars-forward " \t")
539 540 541 542 543 544 545 546 547 548 549
  (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))))))
550
    (newline 1)
551
    (if have-prfx (insert-and-inherit prefix))
Jim Blandy's avatar
Jim Blandy committed
552 553 554 555 556
    (indent-to col 0)
    (goto-char pos)))

(defun delete-indentation (&optional arg)
  "Join this line to previous and fix up whitespace at join.
557
If there is a fill prefix, delete it from the beginning of this line.
Jim Blandy's avatar
Jim Blandy committed
558 559 560 561 562 563 564
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)))
565 566 567
	;; If the second line started with the fill prefix,
	;; delete the prefix.
	(if (and fill-prefix
568
		 (<= (+ (point) (length fill-prefix)) (point-max))
569 570 571 572
		 (string= fill-prefix
			  (buffer-substring (point)
					    (+ (point) (length fill-prefix)))))
	    (delete-region (point) (+ (point) (length fill-prefix))))
Jim Blandy's avatar
Jim Blandy committed
573 574
	(fixup-whitespace))))

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

Jim Blandy's avatar
Jim Blandy committed
577 578 579
(defun delete-blank-lines ()
  "On blank line, delete all surrounding blank lines, leaving just one.
On isolated blank line, delete that one.
580
On nonblank line, delete any immediately following blank lines."
Jim Blandy's avatar
Jim Blandy committed
581 582 583 584 585
  (interactive "*")
  (let (thisblank singleblank)
    (save-excursion
      (beginning-of-line)
      (setq thisblank (looking-at "[ \t]*$"))
Jim Blandy's avatar
Jim Blandy committed
586
      ;; Set singleblank if there is just one blank line here.
Jim Blandy's avatar
Jim Blandy committed
587 588 589 590 591 592
      (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
593
    ;; Delete preceding blank lines, and this one too if it's the only one.
Jim Blandy's avatar
Jim Blandy committed
594 595 596 597 598 599 600 601
    (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
602 603
    ;; Delete following blank lines, unless the current line is blank
    ;; and there are no following blank lines.
Jim Blandy's avatar
Jim Blandy committed
604 605 606 607 608 609 610
    (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
611 612 613 614 615
			   (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
616

617
(defun delete-trailing-whitespace (&optional start end)
618 619
  "Delete all the trailing whitespace across the current buffer.
All whitespace after the last non-whitespace character in a line is deleted.
620
This respects narrowing, created by \\[narrow-to-region] and friends.
621 622 623 624 625 626 627
A formfeed is not considered whitespace by this function.
If the region is active, only delete whitespace within the region."
  (interactive (progn
                 (barf-if-buffer-read-only)
                 (if (use-region-p)
                     (list (region-beginning) (region-end))
                   (list nil nil))))
628 629
  (save-match-data
    (save-excursion
630 631 632 633 634 635 636 637 638 639
      (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)
          (skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
          ;; Don't delete formfeeds, even if they are considered whitespace.
          (save-match-data
            (if (looking-at ".*\f")
                (goto-char (match-end 0))))
          (delete-region (point) (match-end 0)))
640 641 642
        (set-marker end-marker nil))))
  ;; Return nil for the benefit of `write-file-functions'.
  nil)
643

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

Karl Heuer's avatar
Karl Heuer committed
682 683 684
(defun quoted-insert (arg)
  "Read next input character and insert it.
This is useful for inserting control characters.
685
With argument, insert ARG copies of the character.
Jim Blandy's avatar
Jim Blandy committed
686

Karl Heuer's avatar
Karl Heuer committed
687 688 689 690 691 692
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.
693

Karl Heuer's avatar
Karl Heuer committed
694 695 696 697
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.
698

Karl Heuer's avatar
Karl Heuer committed
699 700 701 702
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")
703 704 705 706 707 708 709 710
  (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))))))
711 712 713 714 715 716 717 718
    ;; This used to assume character codes 0240 - 0377 stand for
    ;; characters in some single-byte character set, and converted them
    ;; to Emacs characters.  But in 23.1 this feature is deprecated
    ;; in favor of inserting the corresponding Unicode characters.
    ;; (if (and enable-multibyte-characters
    ;;          (>= char ?\240)
    ;;          (<= char ?\377))
    ;;     (setq char (unibyte-char-to-multibyte char)))
Karl Heuer's avatar
Karl Heuer committed
719 720 721 722 723 724
    (if (> arg 0)
	(if (eq overwrite-mode 'overwrite-mode-binary)
	    (delete-char arg)))
    (while (> arg 0)
      (insert-and-inherit char)
      (setq arg (1- arg)))))
725

Kenichi Handa's avatar
Kenichi Handa committed
726
(defun forward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
727
  "Move forward ARG lines and position at first nonblank character."
728
  (interactive "^p")
Kenichi Handa's avatar
Kenichi Handa committed
729
  (forward-line (or arg 1))
Karl Heuer's avatar
Karl Heuer committed
730
  (skip-chars-forward " \t"))
731

Kenichi Handa's avatar
Kenichi Handa committed
732
(defun backward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
733
  "Move backward ARG lines and position at first nonblank character."
734
  (interactive "^p")
Kenichi Handa's avatar
Kenichi Handa committed
735
  (forward-line (- (or arg 1)))
Karl Heuer's avatar
Karl Heuer committed
736
  (skip-chars-forward " \t"))
Jim Blandy's avatar
Jim Blandy committed
737

Karl Heuer's avatar
Karl Heuer committed
738 739
(defun back-to-indentation ()
  "Move point to the first non-whitespace character on this line."
740
  (interactive "^")
Karl Heuer's avatar
Karl Heuer committed
741
  (beginning-of-line 1)
742
  (skip-syntax-forward " " (line-end-position))
743 744
  ;; Move back over chars that have whitespace syntax but have the p flag.
  (backward-prefix-chars))
Karl Heuer's avatar
Karl Heuer committed
745 746 747 748 749 750 751 752 753 754 755

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

758 759
(defun delete-horizontal-space (&optional backward-only)
  "Delete all spaces and tabs around point.
760
If BACKWARD-ONLY is non-nil, only delete them before point."
761
  (interactive "*P")
762 763 764 765 766 767 768
  (let ((orig-pos (point)))
    (delete-region
     (if backward-only
	 orig-pos
       (progn
	 (skip-chars-forward " \t")
	 (constrain-to-field nil orig-pos t)))
769
     (progn
770 771
       (skip-chars-backward " \t")
       (constrain-to-field nil orig-pos)))))
Karl Heuer's avatar
Karl Heuer committed
772

773
(defun just-one-space (&optional n)
774
  "Delete all spaces and tabs around point, leaving one space (or N spaces).
775
If N is negative, delete newlines as well."
776
  (interactive "*p")
777
  (unless n (setq n 1))
778 779 780 781
  (let ((orig-pos (point))
        (skip-characters (if (< n 0) " \t\n\r" " \t"))
        (n (abs n)))
    (skip-chars-backward skip-characters)
782
    (constrain-to-field nil orig-pos)
783
    (dotimes (i n)
784
      (if (= (following-char) ?\s)
785
	  (forward-char 1)
786
	(insert ?\s)))
787 788 789
    (delete-region
     (point)
     (progn
790
       (skip-chars-forward skip-characters)
791
       (constrain-to-field nil orig-pos t)))))
792

Jim Blandy's avatar
Jim Blandy committed
793
(defun beginning-of-buffer (&optional arg)
794
  "Move point to the beginning of the buffer.
795
With numeric arg N, put point N/10 of the way from the beginning.
796 797
If the buffer is narrowed, this command uses the beginning of the
accessible part of the buffer.
798

799 800
If Transient Mark mode is disabled, leave mark at previous
position, unless a \\[universal-argument] prefix is supplied.
801 802

Don't use this command in Lisp programs!
803
\(goto-char (point-min)) is faster."
804
  (interactive "^P")
805
  (or (consp arg)
806
      (region-active-p)
807
      (push-mark))
808
  (let ((size (- (point-max) (point-min))))
809
    (goto-char (if (and arg (not (consp arg)))
810 811 812 813 814 815 816
		   (+ (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))))
817
  (if (and arg (not (consp arg))) (forward-line 1)))
Jim Blandy's avatar
Jim Blandy committed
818 819

(defun end-of-buffer (&optional arg)
820
  "Move point to the end of the buffer.
821
With numeric arg N, put point N/10 of the way from the end.
822 823
If the buffer is narrowed, this command uses the end of the
accessible part of the buffer.
824

825 826
If Transient Mark mode is disabled, leave mark at previous
position, unless a \\[universal-argument] prefix is supplied.
827 828

Don't use this command in Lisp programs!
829
\(goto-char (point-max)) is faster."
830
  (interactive "^P")
831
  (or (consp arg) (region-active-p) (push-mark))
832
  (let ((size (- (point-max) (point-min))))
833
    (goto-char (if (and arg (not (consp arg)))
834 835 836 837 838 839 840
		   (- (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
841 842
  ;; If we went to a place in the middle of the buffer,
  ;; adjust it to the beginning of a line.
843
  (cond ((and arg (not (consp arg))) (forward-line 1))
844
	((> (point) (window-end nil t))
845 846 847 848
	 ;; 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
849

850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900
(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))
  :group 'editing
  :version "24.1")

(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.
To disable this, set `delete-active-region' to nil.

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."
  (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)
	     (kill-region (region-beginning) (region-end))
	   (delete-region (region-beginning) (region-end))))
	;; In Overwrite mode, maybe untabify while deleting
	((null (or (null overwrite-mode)
		   (<= n 0)
		   (memq (char-before) '(?\t ?\n))
		   (eobp)
		   (eq (char-after) ?\n)))
	 (let* ((ocol (current-column))
		(val (delete-char (- n) killflag)))
	   (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)
901
  "Delete the following N characters (previous if N is negative).
902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921
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.
To disable this, set `delete-active-region' to nil.

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."
  (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)
	     (kill-region (region-beginning) (region-end))
	   (delete-region (region-beginning) (region-end))))
	;; Otherwise, do simple deletion.
	(t (delete-char n killflag))))

Jim Blandy's avatar
Jim Blandy committed
922
(defun mark-whole-buffer ()
Jim Blandy's avatar
Jim Blandy committed
923 924 925 926
  "Put point at beginning and mark at end of buffer.
You probably should not use this function in Lisp programs;
it is usually a mistake for a Lisp function to use any subroutine
that uses or sets the mark."
Jim Blandy's avatar
Jim Blandy committed
927 928
  (interactive)
  (push-mark (point))
929
  (push-mark (point-max) nil t)
Jim Blandy's avatar
Jim Blandy committed
930
  (goto-char (point-min)))
931

932

Karl Heuer's avatar
Karl Heuer committed
933 934
;; Counting lines, one way or another.

Lute Kamstra's avatar
Lute Kamstra committed
935 936 937 938
(defun goto-line (line &optional buffer)
  "Goto LINE, counting from line 1 at beginning of buffer.
Normally, move point in the current buffer, and leave mark at the
previous position.  With just \\[universal-argument] as argument,
939
move point in the most recently selected other buffer, and switch to it.
Lute Kamstra's avatar
Lute Kamstra committed
940

941 942 943 944 945 946 947
If there's a number in the buffer at point, it is the default for LINE.

This function is usually the wrong thing to use in a Lisp program.
What you probably want instead is something like:
  (goto-char (point-min)) (forward-line (1- N))
If at all possible, an even better solution is to use char counts
rather than line counts."
948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981
  (interactive
   (if (and current-prefix-arg (not (consp current-prefix-arg)))
       (list (prefix-numeric-value current-prefix-arg))
     ;; Look for a default, a number in the buffer at point.
     (let* ((default
	      (save-excursion
		(skip-chars-backward "0-9")
		(if (looking-at "[0-9]")
		    (buffer-substring-no-properties
		     (point)
		     (progn (skip-chars-forward "0-9")
			    (point))))))
	    ;; Decide if we're switching buffers.
	    (buffer
	     (if (consp current-prefix-arg)
		 (other-buffer (current-buffer) t)))
	    (buffer-prompt
	     (if buffer
		 (concat " in " (buffer-name buffer))
	       "")))
       ;; Read the argument, offering that number (if any) as default.
       (list (read-from-minibuffer (format (if default "Goto line%s (%s): "
					     "Goto line%s: ")
					   buffer-prompt
					   default)
				   nil nil t
				   'minibuffer-history
				   default)
	     buffer))))
  ;; Switch to the desired buffer, one way or another.
  (if buffer
      (let ((window (get-buffer-window buffer)))
	(if window (select-window window)
	  (switch-to-buffer-other-window buffer))))
982
  ;; Leave mark at previous position
983
  (or (region-active-p) (push-mark))
984
  ;; Move to the specified line number in that buffer.
Karl Heuer's avatar
Karl Heuer committed
985 986
  (save-restriction
    (widen)
987
    (goto-char (point-min))
Karl Heuer's avatar
Karl Heuer committed
988
    (if (eq selective-display t)
Lute Kamstra's avatar
Lute Kamstra committed
989 990
	(re-search-forward "[\n\C-m]" nil 'end (1- line))
      (forward-line (1- line)))))
Jim Blandy's avatar
Jim Blandy committed
991

992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006
(defun count-words-region (start end)
  "Print the number of words in the region.
When called interactively, the word count is printed in echo area."
  (interactive "r")
  (let ((count 0))
    (save-excursion
      (save-restriction
        (narrow-to-region start end)
        (goto-char (point-min))
        (while (forward-word 1)
          (setq count (1+ count)))))
    (if (interactive-p)
        (message "Region has %d words" count))
    count))

Jim Blandy's avatar
Jim Blandy committed
1007
(defun count-lines-region (start end)
1008
  "Print number of lines and characters in the region."
Jim Blandy's avatar
Jim Blandy committed
1009 1010 1011 1012 1013
  (interactive "r")
  (message "Region has %d lines, %d characters"
	   (count-lines start end) (- end start)))

(defun what-line ()
1014
  "Print the current buffer line number and narrowed line number of point."
Jim Blandy's avatar
Jim Blandy committed
1015
  (interactive)