simple.el 235 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, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
Glenn Morris's avatar
Glenn Morris committed
5
;;   Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
6

Pavel Janík's avatar
Pavel Janík committed
7 8 9
;; Maintainer: FSF
;; Keywords: internal

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

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

;; 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
Erik Naggum's avatar
Erik Naggum committed
23
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
24 25
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Jim Blandy's avatar
Jim Blandy committed
26

27 28 29 30 31
;;; 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
32
;;; Code:
Jim Blandy's avatar
Jim Blandy committed
33

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 40 41 42 43 44 45
(defcustom idle-update-delay 0.5
  "*Idle time delay before updating various things on the screen.
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 80
(defun last-buffer (&optional buffer visible-ok frame)
  "Return the last non-hidden displayable buffer in the buffer list.
81 82 83 84 85 86 87
If BUFFER is non-nil, last-buffer will ignore that buffer.
Buffers not visible in windows are preferred to visible buffers,
unless optional argument VISIBLE-OK is non-nil.
If the optional third argument FRAME is non-nil, use that frame's
buffer list instead of the selected frame's buffer list.
If no other buffer exists, the buffer `*scratch*' is returned."
  (setq frame (or frame (selected-frame)))
88 89
  (or (get-next-valid-buffer (nreverse (buffer-list frame))
 			     buffer visible-ok frame)
90 91 92
      (progn
	(set-buffer-major-mode (get-buffer-create "*scratch*"))
	(get-buffer "*scratch*"))))
93 94 95
(defun next-buffer ()
  "Switch to the next buffer in cyclic order."
  (interactive)
96
  (let ((buffer (current-buffer)))
97
    (switch-to-buffer (other-buffer buffer t))
98
    (bury-buffer buffer)))
99 100

(defun previous-buffer ()
101 102
  "Switch to the previous buffer in cyclic order."
  (interactive)
103
  (switch-to-buffer (last-buffer (current-buffer) t)))
104

105

106
;;; next-error support framework
107 108

(defgroup next-error nil
109
  "`next-error' support framework."
110
  :group 'compilation
111
  :version "22.1")
112 113 114 115 116

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

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

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

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

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

161 162
(defvar next-error-highlight-timer nil)

163
(defvar next-error-overlay-arrow-position nil)
164
(put 'next-error-overlay-arrow-position 'overlay-arrow-string "=>")
165 166
(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)

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

(make-variable-buffer-local 'next-error-function)

185
(defsubst next-error-buffer-p (buffer
186
			       &optional avoid-current
187
			       extra-test-inclusive
188
			       extra-test-exclusive)
189
  "Test if BUFFER is a `next-error' capable buffer.
190 191 192 193 194 195 196 197

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.

198
The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
199
that would normally be considered usable.  If it returns nil,
200 201 202 203 204 205 206 207 208 209 210 211 212 213
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
214
					 extra-test-inclusive
215
					 extra-test-exclusive)
216
  "Return a `next-error' capable buffer.
217

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

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

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

269
(defun next-error (&optional arg reset)
270
  "Visit next `next-error' message and corresponding source code.
271 272 273 274

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

275
A prefix ARG specifies how many error messages to move;
276 277 278 279
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.

280
The RESET argument specifies that we should restart from the beginning.
281 282 283 284 285 286

\\[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
287 288 289 290
`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.
291

Juri Linkov's avatar
Juri Linkov committed
292 293 294 295
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.
296 297 298 299

See variables `compilation-parse-errors-function' and
\`compilation-error-regexp-alist' for customization ideas."
  (interactive "P")
300
  (if (consp arg) (setq reset t arg nil))
301 302 303
  (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
304
      (funcall next-error-function (prefix-numeric-value arg) reset)
305 306
      (when next-error-recenter
        (recenter next-error-recenter))
Juri Linkov's avatar
Juri Linkov committed
307
      (run-hooks 'next-error-hook))))
308

309 310 311 312 313 314
(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)
315 316
    (when next-error-recenter
      (recenter next-error-recenter))
317 318
    (run-hooks 'next-error-hook)))

319 320 321
(defalias 'goto-next-locus 'next-error)
(defalias 'next-match 'next-error)

322
(defun previous-error (&optional n)
323
  "Visit previous `next-error' message and corresponding source code.
324 325 326 327 328 329

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

332
(defun first-error (&optional n)
333 334 335 336 337 338 339
  "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))

340
(defun next-error-no-select (&optional n)
341
  "Move point to the next error in the `next-error' buffer and highlight match.
342 343 344 345 346
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")
347 348
  (let ((next-error-highlight next-error-highlight-no-select))
    (next-error n))
349 350
  (pop-to-buffer next-error-last-buffer))

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

360 361 362
;;; Internal variable for `next-error-follow-mode-post-command-hook'.
(defvar next-error-follow-last-line nil)

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

;;; Used as a `post-command-hook' by `next-error-follow-mode'
;;; for the *Compilation* *grep* and *Occur* buffers.
(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))))

385

386 387
;;;

Karl Heuer's avatar
Karl Heuer committed
388 389 390 391
(defun fundamental-mode ()
  "Major mode not specialized for anything in particular.
Other major modes are defined by comparison with this one."
  (interactive)
392
  (kill-all-local-variables)
393 394
  (unless delay-mode-hooks
    (run-hooks 'after-change-major-mode-hook)))
395

Karl Heuer's avatar
Karl Heuer committed
396 397
;; Making and deleting lines.

398 399
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)))

400
(defun newline (&optional arg)
401
  "Insert a newline, and move to left margin of the new line if it's blank.
Dave Love's avatar
Dave Love committed
402 403
If `use-hard-newlines' is non-nil, the newline is marked with the
text-property `hard'.
404
With ARG, insert that many newlines.
Dave Love's avatar
Dave Love committed
405
Call `auto-fill-function' if the current column number is greater
406
than the value of `fill-column' and ARG is nil."
407
  (interactive "*P")
408
  (barf-if-buffer-read-only)
409 410 411 412
  ;; Inserting a newline at the end of a line produces better redisplay in
  ;; try_window_id than inserting at the beginning of a line, and the textual
  ;; result is the same.  So, if we're at beginning of line, pretend to be at
  ;; the end of the previous line.
413
  (let ((flag (and (not (bobp))
414
		   (bolp)
415 416 417 418
		   ;; Make sure no functions want to be told about
		   ;; the range of the changes.
		   (not after-change-functions)
		   (not before-change-functions)
419 420
		   ;; Make sure there are no markers here.
		   (not (buffer-has-markers-at (1- (point))))
421
		   (not (buffer-has-markers-at (point)))
422 423 424 425 426 427
		   ;; Make sure no text properties want to know
		   ;; where the change was.
		   (not (get-char-property (1- (point)) 'modification-hooks))
		   (not (get-char-property (1- (point)) 'insert-behind-hooks))
		   (or (eobp)
		       (not (get-char-property (point) 'insert-in-front-hooks)))
428 429 430 431 432 433 434 435
		   ;; Make sure the newline before point isn't intangible.
		   (not (get-char-property (1- (point)) 'intangible))
		   ;; Make sure the newline before point isn't read-only.
		   (not (get-char-property (1- (point)) 'read-only))
		   ;; Make sure the newline before point isn't invisible.
		   (not (get-char-property (1- (point)) 'invisible))
		   ;; Make sure the newline before point has the same
		   ;; properties as the char before it (if any).
436
		   (< (or (previous-property-change (point)) -2)
437 438 439 440
		      (- (point) 2))))
	(was-page-start (and (bolp)
			     (looking-at page-delimiter)))
	(beforepos (point)))
441 442 443 444 445
    (if flag (backward-char 1))
    ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
    ;; Set last-command-char to tell self-insert what to insert.
    (let ((last-command-char ?\n)
	  ;; Don't auto-fill if we have a numeric argument.
446 447 448
	  ;; Also not if flag is true (it would fill wrong line);
	  ;; there is no need to since we're at BOL.
	  (auto-fill-function (if (or arg flag) nil auto-fill-function)))
449 450 451 452
      (unwind-protect
	  (self-insert-command (prefix-numeric-value arg))
	;; If we get an error in self-insert-command, put point at right place.
	(if flag (forward-char 1))))
453 454 455 456
    ;; Even if we did *not* get an error, keep that forward-char;
    ;; all further processing should apply to the newline that the user
    ;; thinks he inserted.

457 458
    ;; Mark the newline(s) `hard'.
    (if use-hard-newlines
459
	(set-hard-newline-properties
460
	 (- (point) (prefix-numeric-value arg)) (point)))
461 462 463 464 465 466 467 468 469 470 471 472 473 474
    ;; If the newline leaves the previous line blank,
    ;; and we have a left margin, delete that from the blank line.
    (or flag
	(save-excursion
	  (goto-char beforepos)
	  (beginning-of-line)
	  (and (looking-at "[ \t]$")
	       (> (current-left-margin) 0)
	       (delete-region (point) (progn (end-of-line) (point))))))
    ;; 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)))
475 476
  nil)

477 478 479 480 481 482 483
(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)))))
484

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

507 508 509
(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
510
line as well.  With prefix ARG, don't insert `fill-prefix' on new line.
511

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

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

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

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

593 594 595
(defun delete-trailing-whitespace ()
  "Delete all the trailing whitespace across the current buffer.
All whitespace after the last non-whitespace character in a line is deleted.
596 597
This respects narrowing, created by \\[narrow-to-region] and friends.
A formfeed is not considered whitespace by this function."
598 599 600 601
  (interactive "*")
  (save-match-data
    (save-excursion
      (goto-char (point-min))
602 603
      (while (re-search-forward "\\s-$" nil t)
	(skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
604
	;; Don't delete formfeeds, even if they are considered whitespace.
605 606 607
	(save-match-data
	  (if (looking-at ".*\f")
	      (goto-char (match-end 0))))
608
	(delete-region (point) (match-end 0))))))
609

Jim Blandy's avatar
Jim Blandy committed
610 611
(defun newline-and-indent ()
  "Insert a newline, then indent according to major mode.
612
Indentation is done using the value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
613
In programming language modes, this is the same as TAB.
614
In some text modes, where TAB inserts a tab, this command indents to the
615
column specified by the function `current-left-margin'."
Jim Blandy's avatar
Jim Blandy committed
616
  (interactive "*")
617
  (delete-horizontal-space t)
Jim Blandy's avatar
Jim Blandy committed
618
  (newline)
Jim Blandy's avatar
Jim Blandy committed
619 620 621 622 623
  (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,
624
which means calling the current value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
625 626
In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this indents to the
627
column specified by the function `current-left-margin'."
Jim Blandy's avatar
Jim Blandy committed
628
  (interactive "*")
629 630 631 632 633 634
  (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)
635 636 637 638 639 640 641 642 643 644
      ;; 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
645
      (delete-horizontal-space t))
646
    (indent-according-to-mode)))
647

Karl Heuer's avatar
Karl Heuer committed
648 649 650
(defun quoted-insert (arg)
  "Read next input character and insert it.
This is useful for inserting control characters.
Jim Blandy's avatar
Jim Blandy committed
651

Karl Heuer's avatar
Karl Heuer committed
652 653 654 655 656 657
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.
658

Karl Heuer's avatar
Karl Heuer committed
659 660 661 662
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.
663

Karl Heuer's avatar
Karl Heuer committed
664 665 666 667
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")
668
  (let* ((char (let (translation-table-for-input input-method-function)
669 670 671 672
		 (if (or (not overwrite-mode)
			 (eq overwrite-mode 'overwrite-mode-binary))
		     (read-quoted-char)
		   (read-char)))))
Karl Heuer's avatar
Karl Heuer committed
673 674 675 676 677 678 679 680 681 682 683 684 685
    ;; Assume character codes 0240 - 0377 stand for characters in some
    ;; single-byte character set, and convert them to Emacs
    ;; characters.
    (if (and enable-multibyte-characters
	     (>= char ?\240)
	     (<= char ?\377))
	(setq char (unibyte-char-to-multibyte char)))
    (if (> arg 0)
	(if (eq overwrite-mode 'overwrite-mode-binary)
	    (delete-char arg)))
    (while (> arg 0)
      (insert-and-inherit char)
      (setq arg (1- arg)))))
686

Kenichi Handa's avatar
Kenichi Handa committed
687
(defun forward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
688
  "Move forward ARG lines and position at first nonblank character."
689
  (interactive "^p")
Kenichi Handa's avatar
Kenichi Handa committed
690
  (forward-line (or arg 1))
Karl Heuer's avatar
Karl Heuer committed
691
  (skip-chars-forward " \t"))
692

Kenichi Handa's avatar
Kenichi Handa committed
693
(defun backward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
694
  "Move backward ARG lines and position at first nonblank character."
695
  (interactive "^p")
Kenichi Handa's avatar
Kenichi Handa committed
696
  (forward-line (- (or arg 1)))
Karl Heuer's avatar
Karl Heuer committed
697
  (skip-chars-forward " \t"))
Jim Blandy's avatar
Jim Blandy committed
698

Karl Heuer's avatar
Karl Heuer committed
699 700
(defun back-to-indentation ()
  "Move point to the first non-whitespace character on this line."
701
  (interactive "^")
Karl Heuer's avatar
Karl Heuer committed
702
  (beginning-of-line 1)
703
  (skip-syntax-forward " " (line-end-position))
704 705
  ;; Move back over chars that have whitespace syntax but have the p flag.
  (backward-prefix-chars))
Karl Heuer's avatar
Karl Heuer committed
706 707 708 709 710 711 712 713 714 715 716

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

719 720
(defun delete-horizontal-space (&optional backward-only)
  "Delete all spaces and tabs around point.
721
If BACKWARD-ONLY is non-nil, only delete them before point."
722
  (interactive "*P")
723 724 725 726 727 728 729
  (let ((orig-pos (point)))
    (delete-region
     (if backward-only
	 orig-pos
       (progn
	 (skip-chars-forward " \t")
	 (constrain-to-field nil orig-pos t)))
730
     (progn
731 732
       (skip-chars-backward " \t")
       (constrain-to-field nil orig-pos)))))
Karl Heuer's avatar
Karl Heuer committed
733

734
(defun just-one-space (&optional n)
735 736
  "Delete all spaces and tabs around point, leaving one space (or N spaces)."
  (interactive "*p")
737 738 739
  (let ((orig-pos (point)))
    (skip-chars-backward " \t")
    (constrain-to-field nil orig-pos)
740
    (dotimes (i (or n 1))
741
      (if (= (following-char) ?\s)
742
	  (forward-char 1)
743
	(insert ?\s)))
744 745 746 747 748
    (delete-region
     (point)
     (progn
       (skip-chars-forward " \t")
       (constrain-to-field nil orig-pos t)))))
749

Jim Blandy's avatar
Jim Blandy committed
750 751
(defun beginning-of-buffer (&optional arg)
  "Move point to the beginning of the buffer; leave mark at previous position.
752 753
With \\[universal-argument] prefix, do not set mark at previous position.
With numeric arg N, put point N/10 of the way from the beginning.
754 755 756

If the buffer is narrowed, this command uses the beginning and size
of the accessible part of the buffer.
757 758

Don't use this command in Lisp programs!
Jim Blandy's avatar
Jim Blandy committed
759
\(goto-char (point-min)) is faster and avoids clobbering the mark."
760
  (interactive "^P")
761
  (or (consp arg)
762
      (region-active-p)
763
      (push-mark))
764
  (let ((size (- (point-max) (point-min))))
765
    (goto-char (if (and arg (not (consp arg)))
766 767 768 769 770 771 772
		   (+ (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))))
773
  (if (and arg (not (consp arg))) (forward-line 1)))
Jim Blandy's avatar
Jim Blandy committed
774 775 776

(defun end-of-buffer (&optional arg)
  "Move point to the end of the buffer; leave mark at previous position.
777 778
With \\[universal-argument] prefix, do not set mark at previous position.
With numeric arg N, put point N/10 of the way from the end.
779 780 781

If the buffer is narrowed, this command uses the beginning and size
of the accessible part of the buffer.
782 783

Don't use this command in Lisp programs!
Jim Blandy's avatar
Jim Blandy committed
784
\(goto-char (point-max)) is faster and avoids clobbering the mark."
785
  (interactive "^P")
786
  (or (consp arg) (region-active-p) (push-mark))
787
  (let ((size (- (point-max) (point-min))))
788
    (goto-char (if (and arg (not (consp arg)))
789 790 791 792 793 794 795
		   (- (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
796 797
  ;; If we went to a place in the middle of the buffer,
  ;; adjust it to the beginning of a line.
798
  (cond ((and arg (not (consp arg))) (forward-line 1))
799
	((> (point) (window-end nil t))
800 801 802 803
	 ;; 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
804 805

(defun mark-whole-buffer ()
Jim Blandy's avatar
Jim Blandy committed
806 807 808 809
  "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
810 811
  (interactive)
  (push-mark (point))
812
  (push-mark (point-max) nil t)
Jim Blandy's avatar
Jim Blandy committed
813
  (goto-char (point-min)))
814

815

Karl Heuer's avatar
Karl Heuer committed
816 817
;; Counting lines, one way or another.

818 819
(defun goto-line (arg &optional buffer)
  "Goto line ARG, counting from line 1 at beginning of buffer.
820 821 822 823 824
Normally, move point in the current buffer, and leave mark at previous
position.  With just \\[universal-argument] as argument, move point
in the most recently displayed other buffer, and switch to it.
When called from Lisp code, the optional argument BUFFER specifies
a buffer to switch to.
825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860

If there's a number in the buffer at point, it is the default for ARG."
  (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))))
861
  ;; Leave mark at previous position
862
  (or (region-active-p) (push-mark))
863
  ;; Move to the specified line number in that buffer.
Karl Heuer's avatar
Karl Heuer committed
864 865 866 867 868 869
  (save-restriction
    (widen)
    (goto-char 1)
    (if (eq selective-display t)
	(re-search-forward "[\n\C-m]" nil 'end (1- arg))
      (forward-line (1- arg)))))
Jim Blandy's avatar
Jim Blandy committed
870 871

(defun count-lines-region (start end)
872
  "Print number of lines and characters in the region."
Jim Blandy's avatar
Jim Blandy committed
873 874 875 876 877
  (interactive "r")
  (message "Region has %d lines, %d characters"
	   (count-lines start end) (- end start)))

(defun what-line ()
878
  "Print the current buffer line number and narrowed line number of point."
Jim Blandy's avatar
Jim Blandy committed
879
  (interactive)
880
  (let ((start (point-min))
Kenichi Handa's avatar
Kenichi Handa committed
881 882 883 884 885 886 887 888
	(n (line-number-at-pos)))
    (if (= start 1)
	(message "Line %d" n)
      (save-excursion
	(save-restriction
	  (widen)
	  (message "line %d (narrowed line %d)"
		   (+ n (line-number-at-pos start) -1) n))))))
889

Jim Blandy's avatar
Jim Blandy committed
890 891 892
(defun count-lines (start end)
  "Return number of lines between START and END.
This is usually the number of newlines between them,
893
but can be one more if START is not equal to END
Jim Blandy's avatar
Jim Blandy committed
894
and the greater of them is not at the start of a line."
895 896 897 898 899 900
  (save-excursion
    (save-restriction
      (narrow-to-region start end)
      (goto-char (point-min))
      (if (eq selective-display t)
	  (save-match-data
901 902 903 904 905
	    (let ((done 0))
	      (while (re-search-forward "[\n\C-m]" nil t 40)
		(setq done (+ 40 done)))
	      (while (re-search-forward "[\n\C-m]" nil t 1)
		(setq done (+ 1 done)))
906 907 908 909
	      (goto-char (point-max))
	      (if (and (/= start end)
		       (not (bolp)))
		  (1+ done)
910 911
		done)))
	(- (buffer-size) (forward-line (buffer-size)))))))
912

Kenichi Handa's avatar
Kenichi Handa committed
913 914
(defun line-number-at-pos (&optional pos)
  "Return (narrowed) buffer line number at position POS.
915 916 917
If POS is nil, use current buffer location.
Counting starts at (point-min), so the value refers
to the contents of the accessible portion of the buffer."
Kenichi Handa's avatar
Kenichi Handa committed
918 919 920 921 922 923 924 925
  (let ((opoint (or pos (point))) start)
    (save-excursion
      (goto-char (point-min))
      (setq start (point))
      (goto-char opoint)
      (forward-line 0)