simple.el 243 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
;; This file is part of GNU Emacs.

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

;; 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
23
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Jim Blandy's avatar
Jim Blandy committed
24

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

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

35 36
(defvar compilation-current-error)

37 38 39 40 41 42 43
(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
44

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

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

53 54
(defun get-next-valid-buffer (list &optional buffer visible-ok frame)
  "Search LIST for a valid buffer to display in FRAME.
55 56 57 58 59 60
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.
61
If BUFFER is non-nil, ignore occurrences of that buffer in LIST."
62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
  ;; 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)))

77 78
(defun last-buffer (&optional buffer visible-ok frame)
  "Return the last non-hidden displayable buffer in the buffer list.
79 80 81 82 83 84 85
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)))
86 87
  (or (get-next-valid-buffer (nreverse (buffer-list frame))
 			     buffer visible-ok frame)
88 89 90
      (progn
	(set-buffer-major-mode (get-buffer-create "*scratch*"))
	(get-buffer "*scratch*"))))
91 92 93
(defun next-buffer ()
  "Switch to the next buffer in cyclic order."
  (interactive)
94
  (let ((buffer (current-buffer)))
95
    (switch-to-buffer (other-buffer buffer t))
96
    (bury-buffer buffer)))
97 98

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

103

104
;;; next-error support framework
105 106

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

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

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

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

145
(defcustom next-error-recenter nil
146 147 148 149
  "*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))
150 151 152 153
                 (const :tag "No recentering" nil))
  :group 'next-error
  :version "23.1")

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

159 160
(defvar next-error-highlight-timer nil)

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

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

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

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

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.

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

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

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

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

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

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

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

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

\\[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
285 286 287 288
`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.
289

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

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

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

317 318 319
(defalias 'goto-next-locus 'next-error)
(defalias 'next-match 'next-error)

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

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

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

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

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

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

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

;;; 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))))

383

384 385
;;;

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

Stefan Monnier's avatar
Stefan Monnier committed
394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412
;; 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)
    (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
413 414
;; Making and deleting lines.

415 416
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)))

417
(defun newline (&optional arg)
418
  "Insert a newline, and move to left margin of the new line if it's blank.
Dave Love's avatar
Dave Love committed
419 420
If `use-hard-newlines' is non-nil, the newline is marked with the
text-property `hard'.
421
With ARG, insert that many newlines.
Dave Love's avatar
Dave Love committed
422
Call `auto-fill-function' if the current column number is greater
423
than the value of `fill-column' and ARG is nil."
424
  (interactive "*P")
425
  (barf-if-buffer-read-only)
426 427 428 429
  ;; 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.
430
  (let ((flag (and (not (bobp))
431
		   (bolp)
432 433 434 435
		   ;; Make sure no functions want to be told about
		   ;; the range of the changes.
		   (not after-change-functions)
		   (not before-change-functions)
436 437
		   ;; Make sure there are no markers here.
		   (not (buffer-has-markers-at (1- (point))))
438
		   (not (buffer-has-markers-at (point)))
439 440 441 442 443 444
		   ;; 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)))
445 446 447 448 449 450 451 452
		   ;; 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).
453
		   (< (or (previous-property-change (point)) -2)
454 455 456 457
		      (- (point) 2))))
	(was-page-start (and (bolp)
			     (looking-at page-delimiter)))
	(beforepos (point)))
458 459 460 461 462
    (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.
463 464 465
	  ;; 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)))
466 467 468 469
      (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))))
470 471 472 473
    ;; 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.

474 475
    ;; Mark the newline(s) `hard'.
    (if use-hard-newlines
476
	(set-hard-newline-properties
477
	 (- (point) (prefix-numeric-value arg)) (point)))
478 479 480 481 482 483 484 485 486 487 488 489 490 491
    ;; 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)))
492 493
  nil)

494 495 496 497 498 499 500
(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)))))
501

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

524 525 526
(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
527
line as well.  With prefix ARG, don't insert `fill-prefix' on new line.
528

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

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

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

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

610 611 612
(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.
613 614
This respects narrowing, created by \\[narrow-to-region] and friends.
A formfeed is not considered whitespace by this function."
615 616 617 618
  (interactive "*")
  (save-match-data
    (save-excursion
      (goto-char (point-min))
619 620
      (while (re-search-forward "\\s-$" nil t)
	(skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
621
	;; Don't delete formfeeds, even if they are considered whitespace.
622 623 624
	(save-match-data
	  (if (looking-at ".*\f")
	      (goto-char (match-end 0))))
625
	(delete-region (point) (match-end 0))))))
626

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

Karl Heuer's avatar
Karl Heuer committed
665 666 667
(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
668

Karl Heuer's avatar
Karl Heuer committed
669 670 671 672 673 674
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.
675

Karl Heuer's avatar
Karl Heuer committed
676 677 678 679
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.
680

Karl Heuer's avatar
Karl Heuer committed
681 682 683 684
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")
685 686 687 688 689
  (let* ((char (let (translation-table-for-input input-method-function)
		 (if (or (not overwrite-mode)
			 (eq overwrite-mode 'overwrite-mode-binary))
		     (read-quoted-char)
		   (read-char)))))
690 691 692 693 694 695 696 697
    ;; 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
698 699 700 701 702 703
    (if (> arg 0)
	(if (eq overwrite-mode 'overwrite-mode-binary)
	    (delete-char arg)))
    (while (> arg 0)
      (insert-and-inherit char)
      (setq arg (1- arg)))))
704

Kenichi Handa's avatar
Kenichi Handa committed
705
(defun forward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
706
  "Move forward ARG lines and position at first nonblank character."
707
  (interactive "^p")
Kenichi Handa's avatar
Kenichi Handa committed
708
  (forward-line (or arg 1))
Karl Heuer's avatar
Karl Heuer committed
709
  (skip-chars-forward " \t"))
710

Kenichi Handa's avatar
Kenichi Handa committed
711
(defun backward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
712
  "Move backward ARG lines and position at first nonblank character."
713
  (interactive "^p")
Kenichi Handa's avatar
Kenichi Handa committed
714
  (forward-line (- (or arg 1)))
Karl Heuer's avatar
Karl Heuer committed
715
  (skip-chars-forward " \t"))
Jim Blandy's avatar
Jim Blandy committed
716

Karl Heuer's avatar
Karl Heuer committed
717 718
(defun back-to-indentation ()
  "Move point to the first non-whitespace character on this line."
719
  (interactive "^")
Karl Heuer's avatar
Karl Heuer committed
720
  (beginning-of-line 1)
721
  (skip-syntax-forward " " (line-end-position))
722 723
  ;; Move back over chars that have whitespace syntax but have the p flag.
  (backward-prefix-chars))
Karl Heuer's avatar
Karl Heuer committed
724 725 726 727 728 729 730 731 732 733 734

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

737 738
(defun delete-horizontal-space (&optional backward-only)
  "Delete all spaces and tabs around point.
739
If BACKWARD-ONLY is non-nil, only delete them before point."
740
  (interactive "*P")
741 742 743 744 745 746 747
  (let ((orig-pos (point)))
    (delete-region
     (if backward-only
	 orig-pos
       (progn
	 (skip-chars-forward " \t")
	 (constrain-to-field nil orig-pos t)))
748
     (progn
749 750
       (skip-chars-backward " \t")
       (constrain-to-field nil orig-pos)))))
Karl Heuer's avatar
Karl Heuer committed
751

752
(defun just-one-space (&optional n)
753 754
  "Delete all spaces and tabs around point, leaving one space (or N spaces)."
  (interactive "*p")
755 756 757
  (let ((orig-pos (point)))
    (skip-chars-backward " \t")
    (constrain-to-field nil orig-pos)
758
    (dotimes (i (or n 1))
759
      (if (= (following-char) ?\s)
760
	  (forward-char 1)
761
	(insert ?\s)))
762 763 764 765 766
    (delete-region
     (point)
     (progn
       (skip-chars-forward " \t")
       (constrain-to-field nil orig-pos t)))))
767

Jim Blandy's avatar
Jim Blandy committed
768 769
(defun beginning-of-buffer (&optional arg)
  "Move point to the beginning of the buffer; leave mark at previous position.
770 771
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.
772 773 774

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

Don't use this command in Lisp programs!
Jim Blandy's avatar
Jim Blandy committed
777
\(goto-char (point-min)) is faster and avoids clobbering the mark."
778
  (interactive "^P")
779
  (or (consp arg)
780
      (region-active-p)
781
      (push-mark))
782
  (let ((size (- (point-max) (point-min))))
783
    (goto-char (if (and arg (not (consp arg)))
784 785 786 787 788 789 790
		   (+ (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))))
791
  (if (and arg (not (consp arg))) (forward-line 1)))
Jim Blandy's avatar
Jim Blandy committed
792 793 794

(defun end-of-buffer (&optional arg)
  "Move point to the end of the buffer; leave mark at previous position.
795 796
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.
797 798 799

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

Don't use this command in Lisp programs!
Jim Blandy's avatar
Jim Blandy committed
802
\(goto-char (point-max)) is faster and avoids clobbering the mark."
803
  (interactive "^P")
804
  (or (consp arg) (region-active-p) (push-mark))
805
  (let ((size (- (point-max) (point-min))))
806
    (goto-char (if (and arg (not (consp arg)))
807 808 809 810 811 812 813
		   (- (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
814 815
  ;; If we went to a place in the middle of the buffer,
  ;; adjust it to the beginning of a line.
816
  (cond ((and arg (not (consp arg))) (forward-line 1))
817
	((> (point) (window-end nil t))
818 819 820 821
	 ;; 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
822 823

(defun mark-whole-buffer ()
Jim Blandy's avatar
Jim Blandy committed
824 825 826 827
  "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
828 829
  (interactive)
  (push-mark (point))
830
  (push-mark (point-max) nil t)
Jim Blandy's avatar
Jim Blandy committed
831
  (goto-char (point-min)))
832

833

Karl Heuer's avatar
Karl Heuer committed
834 835
;; Counting lines, one way or another.

836 837
(defun goto-line (arg &optional buffer)
  "Goto line ARG, counting from line 1 at beginning of buffer.
838 839 840 841 842
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.
843 844 845 846 847 848 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

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))))
879
  ;; Leave mark at previous position
880
  (or (region-active-p) (push-mark))
881
  ;; Move to the specified line number in that buffer.
Karl Heuer's avatar
Karl Heuer committed
882 883 884 885 886 887
  (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
888 889

(defun count-lines-region (start end)
890
  "Print number of lines and characters in the region."
Jim Blandy's avatar
Jim Blandy committed
891 892 893 894 895
  (interactive "r")
  (message "Region has %d lines, %d characters"
	   (count-lines start end) (- end start)))

(defun what-line ()
896
  "Print the current buffer line number and narrowed line number of point."
Jim Blandy's avatar
Jim Blandy committed
897
  (interactive)
898
  (let ((start (point-min))
Kenichi Handa's avatar
Kenichi Handa committed
899 900 901 902 903 904 905 906
	(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))))))
907

Jim Blandy's avatar
Jim Blandy committed
908 909 910
(defun count-lines (start end)
  "Return number of lines between START and END.
This is usually the number of newlines between them,
911
but can be one more if START is not equal to END
Jim Blandy's avatar
Jim Blandy committed
912
and the greater of them is not at the start of a line."
913 914 915 916 917 918
  (save-excursion
    (save-restriction
      (narrow-to-region start end)
      (goto-char (point-min))
      (if (eq selective-display t)
	  (save-match-data
919 920 921 922 923
	    (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)))
924 925 926 927
	      (goto-char (point-max))
	      (if (and (/= start end)
		       (not (bolp)))
		  (1+ done)
928 929
		done)))
	(- (buffer-size) (forward-line (buffer-size)))))))
930

Kenichi Handa's avatar
Kenichi Handa committed
931 932
(defun line-number-at-pos (&optional pos)
  "Return (narrowed) buffer line number at position POS.
933 934 935
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
936 937 938 939 940 941 942 943
  (let ((opoint (or pos (point))) start)
    (save-excursion
      (goto-char (point-min))
      (setq start (point))
      (goto-char opoint)
      (forward-line 0)
      (1+ (count-lines start (point))))))

944 945
(defun what-cursor-position (&optional detail)
  "Print info on cursor position (on screen and within buffer).
946
Also describe the character after point, and give its character code
947 948 949 950 951 952 953
in octal, decimal and hex.

For a non-ASCII multibyte character, also give its encoding in the
buffer's selected coding system if the coding system encodes the
character safely.  If the character is encoded into one byte, that
code is shown in hex.  If the character is encoded into more than one
byte, just \"...\" is shown.
954

955
In addition, with prefix argument, show details about that character
956
in *Help* buffer.  See also the command `describe-char'."
957
  (interactive "P")
Jim Blandy's avatar
Jim Blandy committed
958 959 960 961 962 963 964 965 966 967 968 969 970 971 972
  (let* ((char (following-char))
	 (beg (point-min))
	 (end (point-max))
         (pos (point))
	 (total (buffer-size))
	 (percent (if (> total 50000)
		      ;; Avoid overflow from multiplying by 100!
		      (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
		    (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
	 (hscroll (if (= (window-hscroll) 0)
		      ""
		    (format " Hscroll=%d" (window-hscroll))))
	 (col (current-column)))
    (if (= pos end)
	(if (or (/= beg 1) (/= end (1+ total)))
973
	    (message "point=%d of %d (%d%%) <%d-%d> column=%d%s"
Jim Blandy's avatar
Jim Blandy committed
974
		     pos total percent beg end col hscroll)
975
	  (message "point=%d of %d (EOB) column=%d%s"
976
		   pos total col hscroll))
977
      (let ((coding buffer-file-coding-system)
978
	    encoded encoding-msg display-prop under-display)
979 980 981
	(if (or (not coding)
		(eq (coding-system-type coding) t))
	    (setq coding default-buffer-file-coding-system))
Kenichi Handa's avatar
Kenichi Handa committed
982
	(if (eq (char-charset char) 'eight-bit)
983
	    (setq encoding-msg
984
		  (format "(%d, #o%o, #x%x, raw-byte)" char char char))
985 986 987 988 989 990 991 992 993 994 995 996 997 998 999
	  ;; Check if the character is displayed with some `display'
	  ;; text property.  In that case, set under-display to the
	  ;; buffer substring covered by that property.
	  (setq display-prop (get-text-property pos 'display))
	  (if display-prop
	      (let ((to (or (next-single-property-change pos 'display)
			    (point-max))))
		(if (< to (+ pos 4))
		    (setq under-display "")
		  (setq under-display "..."
			to (+ pos 4)))
		(setq under-display
		      (concat (buffer-substring-no-properties pos to)
			      under-display)))
	    (setq encoded (and (>= char 128) (encode-coding-char char coding))))
1000
	  (setq encoding-msg
1001 1002
		(if display-prop
		    (if (not (stringp display-prop))
1003
			(format "(%d, #o%o, #x%x, part of display \"%s\")"
1004
				char char char under-display)
1005
		      (format "(%d, #o%o, #x%x, part of display \"%s\"->\"%s\")"
1006 1007
			      char char char under-display display-prop))
		  (if encoded
1008
		      (format "(%d, #o%o, #x%x, file %s)"
1009 1010 1011 1012
			      char char char
			      (if (> (length encoded) 1)
				  "..."
				(encoded-string-description encoded coding)))
1013
		    (format "(%d, #o%o, #x%x)" char char char)))))
1014
	(if detail
1015
	    ;; We show the detailed information about CHAR.
Richard M. Stallman's avatar