simple.el 214 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 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
5

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

Jim Blandy's avatar
Jim Blandy committed
9 10 11 12
;; 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
Eric S. Raymond's avatar
Eric S. Raymond committed
13
;; the Free Software Foundation; either version 2, or (at your option)
Jim Blandy's avatar
Jim Blandy committed
14 15 16 17 18 19 20 21
;; 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
22
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
23 24
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Jim Blandy's avatar
Jim Blandy committed
25

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

Gerd Moellmann's avatar
Gerd Moellmann committed
33
(eval-when-compile
34
  (autoload 'widget-convert "wid-edit")
Richard M. Stallman's avatar
Richard M. Stallman committed
35
  (autoload '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 88 89 90 91 92 93 94 95
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)))
  (or (get-next-valid-buffer (frame-parameter frame 'buried-buffer-list)
			     buffer visible-ok frame)
      (get-next-valid-buffer (nreverse (buffer-list frame))
			     buffer visible-ok frame)
      (progn
	(set-buffer-major-mode (get-buffer-create "*scratch*"))
	(get-buffer "*scratch*"))))

96 97 98
(defun next-buffer ()
  "Switch to the next buffer in cyclic order."
  (interactive)
99 100 101 102 103 104 105 106
  (let ((buffer (current-buffer))
	(bbl (frame-parameter nil 'buried-buffer-list)))
    (switch-to-buffer (other-buffer buffer t))
    (bury-buffer buffer)
    (set-frame-parameter nil 'buried-buffer-list
			 (cons buffer (delq buffer bbl)))))

(defun previous-buffer ()
107 108
  "Switch to the previous buffer in cyclic order."
  (interactive)
109 110 111 112 113 114 115 116
  (let ((buffer (last-buffer (current-buffer) t))
	(bbl (frame-parameter nil 'buried-buffer-list)))
    (switch-to-buffer buffer)
    ;; Clean up buried-buffer-list up to and including the chosen buffer.
    (while (and bbl (not (eq (car bbl) buffer)))
      (setq bbl (cdr bbl)))
    (set-frame-parameter nil 'buried-buffer-list bbl)))

117

118
;;; next-error support framework
119 120

(defgroup next-error nil
121
  "`next-error' support framework."
122
  :group 'compilation
123
  :version "22.1")
124 125 126 127 128

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

131
(defcustom next-error-highlight 0.5
132
  "*Highlighting of locations in selected source buffers.
133 134 135 136
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.
137 138
If nil, don't highlight the locus in the source buffer.
If `fringe-arrow', indicate the locus by the fringe arrow."
139
  :type '(choice (number :tag "Highlight for specified time")
140
                 (const :tag "Semipermanent highlighting" t)
141
                 (const :tag "No highlighting" nil)
142
                 (const :tag "Fringe arrow" fringe-arrow))
143
  :group 'next-error
144
  :version "22.1")
145

146 147
(defcustom next-error-highlight-no-select 0.5
  "*Highlighting of locations in `next-error-no-select'.
148
If number, highlight the locus in `next-error' face for given time in seconds.
149
If t, highlight the locus indefinitely until some other locus replaces it.
150 151
If nil, don't highlight the locus in the source buffer.
If `fringe-arrow', indicate the locus by the fringe arrow."
152
  :type '(choice (number :tag "Highlight for specified time")
153
                 (const :tag "Semipermanent highlighting" t)
154
                 (const :tag "No highlighting" nil)
155
                 (const :tag "Fringe arrow" fringe-arrow))
156
  :group 'next-error
157
  :version "22.1")
158

159
(defcustom next-error-recenter nil
160 161 162 163
  "*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))
164 165 166 167
                 (const :tag "No recentering" nil))
  :group 'next-error
  :version "23.1")

Juri Linkov's avatar
Juri Linkov committed
168 169 170 171 172
(defcustom next-error-hook nil
  "*List of hook functions run by `next-error' after visiting source file."
  :type 'hook
  :group 'next-error)

173 174
(defvar next-error-highlight-timer nil)

175
(defvar next-error-overlay-arrow-position nil)
176
(put 'next-error-overlay-arrow-position 'overlay-arrow-string "=>")
177 178
(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)

179
(defvar next-error-last-buffer nil
180
  "The most recent `next-error' buffer.
181 182 183 184 185
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
186 187 188 189 190 191 192 193
  "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.")
194 195 196

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

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

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.

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

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

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

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

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

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

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

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

\\[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
299 300 301 302
`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.
303

Juri Linkov's avatar
Juri Linkov committed
304 305 306 307
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.
308 309 310 311

See variables `compilation-parse-errors-function' and
\`compilation-error-regexp-alist' for customization ideas."
  (interactive "P")
312
  (if (consp arg) (setq reset t arg nil))
313 314 315
  (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
316
      (funcall next-error-function (prefix-numeric-value arg) reset)
317 318
      (when next-error-recenter
        (recenter next-error-recenter))
Juri Linkov's avatar
Juri Linkov committed
319
      (run-hooks 'next-error-hook))))
320

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

331 332 333
(defalias 'goto-next-locus 'next-error)
(defalias 'next-match 'next-error)

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

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

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

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

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

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

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

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

397

398 399
;;;

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

Karl Heuer's avatar
Karl Heuer committed
408 409
;; Making and deleting lines.

410 411
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)))

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

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

489 490 491 492 493 494 495
(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)))))
496

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

519 520 521
(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
522
line as well.  With prefix ARG, don't insert `fill-prefix' on new line.
523

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

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

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

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

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

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

Karl Heuer's avatar
Karl Heuer committed
651 652 653
(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
654

Karl Heuer's avatar
Karl Heuer committed
655 656 657 658 659 660
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.
661

Karl Heuer's avatar
Karl Heuer committed
662 663 664 665
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.
666

Karl Heuer's avatar
Karl Heuer committed
667 668 669 670
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")
671
  (let* ((char (let (translation-table-for-input input-method-function)
672 673 674 675
		 (if (or (not overwrite-mode)
			 (eq overwrite-mode 'overwrite-mode-binary))
		     (read-quoted-char)
		   (read-char)))))
Karl Heuer's avatar
Karl Heuer committed
676 677 678 679 680 681 682 683 684 685 686 687 688
    ;; 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)))))
689

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

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

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

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

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

737
(defun just-one-space (&optional n)
738 739
  "Delete all spaces and tabs around point, leaving one space (or N spaces)."
  (interactive "*p")
740 741 742
  (let ((orig-pos (point)))
    (skip-chars-backward " \t")
    (constrain-to-field nil orig-pos)
743
    (dotimes (i (or n 1))
744
      (if (= (following-char) ?\s)
745
	  (forward-char 1)
746
	(insert ?\s)))
747 748 749 750 751
    (delete-region
     (point)
     (progn
       (skip-chars-forward " \t")
       (constrain-to-field nil orig-pos t)))))
752

Jim Blandy's avatar
Jim Blandy committed
753 754
(defun beginning-of-buffer (&optional arg)
  "Move point to the beginning of the buffer; leave mark at previous position.
755 756
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.
757 758 759

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

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

(defun end-of-buffer (&optional arg)
  "Move point to the end of the buffer; leave mark at previous position.
780 781
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.
782 783 784

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

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

(defun mark-whole-buffer ()
Jim Blandy's avatar
Jim Blandy committed
811 812 813 814
  "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
815 816
  (interactive)
  (push-mark (point))
817
  (push-mark (point-max) nil t)
Jim Blandy's avatar
Jim Blandy committed
818
  (goto-char (point-min)))
819

820

Karl Heuer's avatar
Karl Heuer committed
821 822
;; Counting lines, one way or another.

823 824
(defun goto-line (arg &optional buffer)
  "Goto line ARG, counting from line 1 at beginning of buffer.
Eli Zaretskii's avatar
Eli Zaretskii committed
825 826 827 828
Normally, move point in the current buffer.
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.
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 861 862 863 864 865

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))))
  ;; Move to the specified line number in that buffer.
Karl Heuer's avatar
Karl Heuer committed
866 867 868 869 870
  (save-restriction
    (widen)
    (goto-char 1)
    (if (eq selective-display t)
	(re-search-forward "[\n\C-m]" nil 'end (1- arg))
871
      (forward-line (1- arg)))))
Jim Blandy's avatar
Jim Blandy committed
872 873

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

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

Jim Blandy's avatar
Jim Blandy committed
892 893 894
(defun count-lines (start end)
  "Return number of lines between START and END.
This is usually the number of newlines between them,
895
but can be one more if START is not equal to END
Jim Blandy's avatar
Jim Blandy committed
896
and the greater of them is not at the start of a line."
897 898 899 900 901 902
  (save-excursion
    (save-restriction
      (narrow-to-region start end)
      (goto-char (point-min))
      (if (eq selective-display t)
	  (save-match-data
903 904 905 906 907
	    (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)))
908 909 910 911
	      (goto-char (point-max))
	      (if (and (/= start end)
		       (not (bolp)))
		  (1+ done)
912 913
		done)))
	(- (buffer-size) (forward-line (buffer-size)))))))
914

915
(defun line-number-at-pos (&optional pos)
Kim F. Storm's avatar
Kim F. Storm committed
916
  "Return (narrowed) buffer line number at position POS.
917 918 919
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."
Kim F. Storm's avatar
Kim F. Storm committed
920 921 922 923 924 925 926 927
  (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))))))

928 929
(defun what-cursor-position (&optional detail)
  "Print info on cursor position (on screen and within buffer).
930
Also describe the character after point, and give its character code
931 932 933 934 935 936 937
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.