simple.el 201 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,
4
;;               2000, 2001, 2002, 2003, 2004, 2005
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
Eric S. Raymond's avatar
Eric S. Raymond committed
14
;; the Free Software Foundation; either version 2, 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 24 25
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, 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

Gerd Moellmann's avatar
Gerd Moellmann committed
34
(eval-when-compile
35
  (autoload 'widget-convert "wid-edit")
Richard M. Stallman's avatar
Richard M. Stallman committed
36
  (autoload 'shell-mode "shell"))
Gerd Moellmann's avatar
Gerd Moellmann committed
37

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

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

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

54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
(defun next-buffer ()
  "Switch to the next buffer in cyclic order."
  (interactive)
  (let ((buffer (current-buffer)))
    (switch-to-buffer (other-buffer buffer))
    (bury-buffer buffer)))

(defun prev-buffer ()
  "Switch to the previous buffer in cyclic order."
  (interactive)
  (let ((list (nreverse (buffer-list)))
	found)
    (while (and (not found) list)
      (let ((buffer (car list)))
	(if (and (not (get-buffer-window buffer))
		 (not (string-match "\\` " (buffer-name buffer))))
	    (setq found buffer)))
      (setq list (cdr list)))
    (switch-to-buffer found)))
73

74
;;; next-error support framework
75 76 77 78

(defgroup next-error nil
  "next-error support framework."
  :group 'compilation
79
  :version "22.1")
80 81 82 83 84

(defface next-error
  '((t (:inherit region)))
  "Face used to highlight next error locus."
  :group 'next-error
85
  :version "22.1")
86 87 88 89 90 91 92 93 94 95 96 97

(defcustom next-error-highlight 0.1
  "*Highlighting of locations in selected source buffers.
If number, highlight the locus in next-error face for given time in seconds.
If t, use persistent overlays fontified in next-error face.
If nil, don't highlight the locus in the source buffer.
If `fringe-arrow', indicate the locus by the fringe arrow."
  :type '(choice (number :tag "Delay")
                 (const :tag "Persistent overlay" t)
                 (const :tag "No highlighting" nil)
                 (const :tag "Fringe arrow" 'fringe-arrow))
  :group 'next-error
98
  :version "22.1")
99 100 101 102 103 104 105 106 107 108 109 110

(defcustom next-error-highlight-no-select 0.1
  "*Highlighting of locations in non-selected source buffers.
If number, highlight the locus in next-error face for given time in seconds.
If t, use persistent overlays fontified in next-error face.
If nil, don't highlight the locus in the source buffer.
If `fringe-arrow', indicate the locus by the fringe arrow."
  :type '(choice (number :tag "Delay")
                 (const :tag "Persistent overlay" t)
                 (const :tag "No highlighting" nil)
                 (const :tag "Fringe arrow" 'fringe-arrow))
  :group 'next-error
111
  :version "22.1")
112

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

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

119 120 121 122 123 124 125
(defvar next-error-last-buffer nil
  "The most recent next-error buffer.
A buffer becomes most recent when its compilation, grep, or
similar mode is started, or when it is used with \\[next-error]
or \\[compile-goto-error].")

(defvar next-error-function nil
126 127 128 129 130 131 132 133
  "Function to use to find the next error in the current buffer.
The function is called with 2 parameters:
ARG is an integer specifying by how many errors to move.
RESET is a boolean which, if non-nil, says to go back to the beginning
of the errors before moving.
Major modes providing compile-like functionality should set this variable
to indicate to `next-error' that this is a candidate buffer and how
to navigate in it.")
134 135 136

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

137
(defsubst next-error-buffer-p (buffer
138
			       &optional avoid-current
139
			       extra-test-inclusive
140 141
			       extra-test-exclusive)
  "Test if BUFFER is a next-error capable buffer.
142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165

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.

The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer
that would normally be considered usable.  if it returns nil,
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
166
					 extra-test-inclusive
167 168
					 extra-test-exclusive)
  "Return a next-error capable buffer.
169 170 171 172 173 174 175 176 177 178
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 buffers
that normally would not qualify.  If it returns t, the buffer
in question is treated as usable.

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

220
(defun next-error (&optional arg reset)
221 222 223 224 225
  "Visit next next-error message and corresponding source code.

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

226
A prefix ARG specifies how many error messages to move;
227 228 229 230
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.

231
The RESET argument specifies that we should restart from the beginning.
232 233 234 235 236 237

\\[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
238 239 240 241
`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.
242 243 244 245 246 247 248 249

Once \\[next-error] has chosen the buffer for error messages,
it stays with that buffer until you use it in some other buffer which
uses Compilation mode or Compilation Minor mode.

See variables `compilation-parse-errors-function' and
\`compilation-error-regexp-alist' for customization ideas."
  (interactive "P")
250
  (if (consp arg) (setq reset t arg nil))
251 252 253
  (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
254
      (funcall next-error-function (prefix-numeric-value arg) reset))))
255 256 257 258

(defalias 'goto-next-locus 'next-error)
(defalias 'next-match 'next-error)

259
(defun previous-error (&optional n)
260 261 262 263 264 265 266
  "Visit previous next-error message and corresponding source code.

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

269
(defun first-error (&optional n)
270 271 272 273 274 275 276
  "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))

277
(defun next-error-no-select (&optional n)
278 279 280 281 282 283
  "Move point to the next error in the next-error buffer and highlight match.
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")
284 285
  (let ((next-error-highlight next-error-highlight-no-select))
    (next-error n))
286 287
  (pop-to-buffer next-error-last-buffer))

288
(defun previous-error-no-select (&optional n)
289 290 291 292 293 294
  "Move point to the previous error in the next-error buffer and highlight match.
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")
295
  (next-error-no-select (- (or n 1))))
296

297 298 299
;;; Internal variable for `next-error-follow-mode-post-command-hook'.
(defvar next-error-follow-last-line nil)

Eli Zaretskii's avatar
Eli Zaretskii committed
300
(define-minor-mode next-error-follow-minor-mode
301
  "Minor mode for compilation, occur and diff modes.
Eli Zaretskii's avatar
Eli Zaretskii committed
302 303 304
When turned on, cursor motion in the compilation, grep, occur or diff
buffer causes automatic display of the corresponding source code
location."
305
  :group 'next-error :init-value " Fol"
306
  (if (not next-error-follow-minor-mode)
307 308 309 310 311 312 313 314 315 316 317 318 319 320 321
      (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)
    (make-variable-buffer-local 'next-error-follow-last-line)))

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

322

323 324
;;;

Karl Heuer's avatar
Karl Heuer committed
325 326 327 328
(defun fundamental-mode ()
  "Major mode not specialized for anything in particular.
Other major modes are defined by comparison with this one."
  (interactive)
329 330
  (kill-all-local-variables)
  (run-hooks 'after-change-major-mode-hook))
331

Karl Heuer's avatar
Karl Heuer committed
332 333
;; Making and deleting lines.

334
(defun newline (&optional arg)
335
  "Insert a newline, and move to left margin of the new line if it's blank.
Dave Love's avatar
Dave Love committed
336 337
If `use-hard-newlines' is non-nil, the newline is marked with the
text-property `hard'.
338
With ARG, insert that many newlines.
Dave Love's avatar
Dave Love committed
339
Call `auto-fill-function' if the current column number is greater
340
than the value of `fill-column' and ARG is nil."
341
  (interactive "*P")
342
  (barf-if-buffer-read-only)
343 344 345 346
  ;; 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.
347
  (let ((flag (and (not (bobp))
348
		   (bolp)
349 350 351 352
		   ;; Make sure no functions want to be told about
		   ;; the range of the changes.
		   (not after-change-functions)
		   (not before-change-functions)
353 354
		   ;; Make sure there are no markers here.
		   (not (buffer-has-markers-at (1- (point))))
355
		   (not (buffer-has-markers-at (point)))
356 357 358 359 360 361
		   ;; 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)))
362 363 364 365 366 367 368 369
		   ;; 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).
370
		   (< (or (previous-property-change (point)) -2)
371 372 373 374
		      (- (point) 2))))
	(was-page-start (and (bolp)
			     (looking-at page-delimiter)))
	(beforepos (point)))
375 376 377 378 379
    (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.
380 381 382
	  ;; 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)))
383 384 385 386
      (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))))
387 388 389 390
    ;; 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.

391 392
    ;; Mark the newline(s) `hard'.
    (if use-hard-newlines
393
	(set-hard-newline-properties
394
	 (- (point) (if arg (prefix-numeric-value arg) 1)) (point)))
395 396 397 398 399 400 401 402 403 404 405 406 407 408
    ;; 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)))
409 410
  nil)

411 412 413 414 415 416 417
(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)))))
418

419
(defun open-line (n)
420
  "Insert a newline and leave point before it.
421
If there is a fill prefix and/or a left-margin, insert them on the new line
422
if the line would have been blank.
423
With arg N, insert N newlines."
Jim Blandy's avatar
Jim Blandy committed
424
  (interactive "*p")
425
  (let* ((do-fill-prefix (and fill-prefix (bolp)))
426
	 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
427 428 429
	 (loc (point))
	 ;; Don't expand an abbrev before point.
	 (abbrev-mode nil))
430
    (newline n)
431
    (goto-char loc)
432
    (while (> n 0)
433 434 435 436
      (cond ((bolp)
	     (if do-left-margin (indent-to (current-left-margin)))
	     (if do-fill-prefix (insert-and-inherit fill-prefix))))
      (forward-line 1)
437
      (setq n (1- n)))
438 439
    (goto-char loc)
    (end-of-line)))
Jim Blandy's avatar
Jim Blandy committed
440

441 442 443
(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
444
line as well.  With prefix ARG, don't insert fill-prefix on new line.
445

446
When called from Lisp code, ARG may be a prefix string to copy."
447
  (interactive "*P")
Jim Blandy's avatar
Jim Blandy committed
448
  (skip-chars-forward " \t")
449 450 451 452 453 454 455 456 457 458 459
  (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))))))
460
    (newline 1)
461
    (if have-prfx (insert-and-inherit prefix))
Jim Blandy's avatar
Jim Blandy committed
462 463 464 465 466
    (indent-to col 0)
    (goto-char pos)))

(defun delete-indentation (&optional arg)
  "Join this line to previous and fix up whitespace at join.
467
If there is a fill prefix, delete it from the beginning of this line.
Jim Blandy's avatar
Jim Blandy committed
468 469 470 471 472 473 474
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)))
475 476 477
	;; If the second line started with the fill prefix,
	;; delete the prefix.
	(if (and fill-prefix
478
		 (<= (+ (point) (length fill-prefix)) (point-max))
479 480 481 482
		 (string= fill-prefix
			  (buffer-substring (point)
					    (+ (point) (length fill-prefix)))))
	    (delete-region (point) (+ (point) (length fill-prefix))))
Jim Blandy's avatar
Jim Blandy committed
483 484
	(fixup-whitespace))))

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

Jim Blandy's avatar
Jim Blandy committed
487 488 489
(defun delete-blank-lines ()
  "On blank line, delete all surrounding blank lines, leaving just one.
On isolated blank line, delete that one.
490
On nonblank line, delete any immediately following blank lines."
Jim Blandy's avatar
Jim Blandy committed
491 492 493 494 495
  (interactive "*")
  (let (thisblank singleblank)
    (save-excursion
      (beginning-of-line)
      (setq thisblank (looking-at "[ \t]*$"))
Jim Blandy's avatar
Jim Blandy committed
496
      ;; Set singleblank if there is just one blank line here.
Jim Blandy's avatar
Jim Blandy committed
497 498 499 500 501 502
      (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
503
    ;; Delete preceding blank lines, and this one too if it's the only one.
Jim Blandy's avatar
Jim Blandy committed
504 505 506 507 508 509 510 511
    (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
512 513
    ;; Delete following blank lines, unless the current line is blank
    ;; and there are no following blank lines.
Jim Blandy's avatar
Jim Blandy committed
514 515 516 517 518 519 520
    (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
521 522 523 524 525
			   (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
526

527 528 529
(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.
530 531
This respects narrowing, created by \\[narrow-to-region] and friends.
A formfeed is not considered whitespace by this function."
532 533 534 535
  (interactive "*")
  (save-match-data
    (save-excursion
      (goto-char (point-min))
536 537
      (while (re-search-forward "\\s-$" nil t)
	(skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
538
	;; Don't delete formfeeds, even if they are considered whitespace.
539 540 541
	(save-match-data
	  (if (looking-at ".*\f")
	      (goto-char (match-end 0))))
542
	(delete-region (point) (match-end 0))))))
543

Jim Blandy's avatar
Jim Blandy committed
544 545
(defun newline-and-indent ()
  "Insert a newline, then indent according to major mode.
546
Indentation is done using the value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
547
In programming language modes, this is the same as TAB.
548
In some text modes, where TAB inserts a tab, this command indents to the
549
column specified by the function `current-left-margin'."
Jim Blandy's avatar
Jim Blandy committed
550
  (interactive "*")
551
  (delete-horizontal-space t)
Jim Blandy's avatar
Jim Blandy committed
552
  (newline)
Jim Blandy's avatar
Jim Blandy committed
553 554 555 556 557
  (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,
558
which means calling the current value of `indent-line-function'.
Jim Blandy's avatar
Jim Blandy committed
559 560
In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this indents to the
561
column specified by the function `current-left-margin'."
Jim Blandy's avatar
Jim Blandy committed
562
  (interactive "*")
563 564 565 566 567 568
  (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)
569 570
      (indent-according-to-mode)
      (delete-horizontal-space t))
571
    (indent-according-to-mode)))
572

Karl Heuer's avatar
Karl Heuer committed
573 574 575
(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
576

Karl Heuer's avatar
Karl Heuer committed
577 578 579 580 581 582
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.
583

Karl Heuer's avatar
Karl Heuer committed
584 585 586 587
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.
588

Karl Heuer's avatar
Karl Heuer committed
589 590 591 592
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")
593
  (let* ((char (let (translation-table-for-input)
594 595 596 597
		 (if (or (not overwrite-mode)
			 (eq overwrite-mode 'overwrite-mode-binary))
		     (read-quoted-char)
		   (read-char)))))
Karl Heuer's avatar
Karl Heuer committed
598 599 600 601 602 603 604 605 606 607 608 609 610
    ;; 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)))))
611

612
(defun forward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
613 614
  "Move forward ARG lines and position at first nonblank character."
  (interactive "p")
615
  (forward-line (or arg 1))
Karl Heuer's avatar
Karl Heuer committed
616
  (skip-chars-forward " \t"))
617

618
(defun backward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
619 620
  "Move backward ARG lines and position at first nonblank character."
  (interactive "p")
621
  (forward-line (- (or arg 1)))
Karl Heuer's avatar
Karl Heuer committed
622
  (skip-chars-forward " \t"))
Jim Blandy's avatar
Jim Blandy committed
623

Karl Heuer's avatar
Karl Heuer committed
624 625 626 627
(defun back-to-indentation ()
  "Move point to the first non-whitespace character on this line."
  (interactive)
  (beginning-of-line 1)
628
  (skip-syntax-forward " " (line-end-position))
629 630
  ;; Move back over chars that have whitespace syntax but have the p flag.
  (backward-prefix-chars))
Karl Heuer's avatar
Karl Heuer committed
631 632 633 634 635 636 637 638 639 640 641 642 643

(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
      (insert ?\ ))))

644 645 646
(defun delete-horizontal-space (&optional backward-only)
  "Delete all spaces and tabs around point.
If BACKWARD-ONLY is non-nil, only delete spaces before point."
Karl Heuer's avatar
Karl Heuer committed
647
  (interactive "*")
648 649 650 651 652 653 654
  (let ((orig-pos (point)))
    (delete-region
     (if backward-only
	 orig-pos
       (progn
	 (skip-chars-forward " \t")
	 (constrain-to-field nil orig-pos t)))
655
     (progn
656 657
       (skip-chars-backward " \t")
       (constrain-to-field nil orig-pos)))))
Karl Heuer's avatar
Karl Heuer committed
658

659
(defun just-one-space (&optional n)
660 661
  "Delete all spaces and tabs around point, leaving one space (or N spaces)."
  (interactive "*p")
662 663 664
  (let ((orig-pos (point)))
    (skip-chars-backward " \t")
    (constrain-to-field nil orig-pos)
665
    (dotimes (i (or n 1))
666 667 668
      (if (= (following-char) ?\ )
	  (forward-char 1)
	(insert ?\ )))
669 670 671 672 673
    (delete-region
     (point)
     (progn
       (skip-chars-forward " \t")
       (constrain-to-field nil orig-pos t)))))
674

Jim Blandy's avatar
Jim Blandy committed
675 676
(defun beginning-of-buffer (&optional arg)
  "Move point to the beginning of the buffer; leave mark at previous position.
677 678
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.
679 680 681

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

Don't use this command in Lisp programs!
Jim Blandy's avatar
Jim Blandy committed
684 685
\(goto-char (point-min)) is faster and avoids clobbering the mark."
  (interactive "P")
686
  (or (consp arg)
687 688
      (and transient-mark-mode mark-active)
      (push-mark))
689
  (let ((size (- (point-max) (point-min))))
690
    (goto-char (if (and arg (not (consp arg)))
691 692 693 694 695 696 697
		   (+ (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))))
Jim Blandy's avatar
Jim Blandy committed
698 699 700 701
  (if arg (forward-line 1)))

(defun end-of-buffer (&optional arg)
  "Move point to the end of the buffer; leave mark at previous position.
702 703
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.
704 705 706

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

Don't use this command in Lisp programs!
Jim Blandy's avatar
Jim Blandy committed
709 710
\(goto-char (point-max)) is faster and avoids clobbering the mark."
  (interactive "P")
711
  (or (consp arg)
712 713
      (and transient-mark-mode mark-active)
      (push-mark))
714
  (let ((size (- (point-max) (point-min))))
715
    (goto-char (if (and arg (not (consp arg)))
716 717 718 719 720 721 722
		   (- (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
723 724
  ;; If we went to a place in the middle of the buffer,
  ;; adjust it to the beginning of a line.
725
  (cond (arg (forward-line 1))
726
	((> (point) (window-end nil t))
727 728 729 730
	 ;; 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
731 732

(defun mark-whole-buffer ()
Jim Blandy's avatar
Jim Blandy committed
733 734 735 736
  "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
737 738
  (interactive)
  (push-mark (point))
739
  (push-mark (point-max) nil t)
Jim Blandy's avatar
Jim Blandy committed
740
  (goto-char (point-min)))
741

742

Karl Heuer's avatar
Karl Heuer committed
743 744
;; Counting lines, one way or another.

745 746
(defun goto-line (arg &optional buffer)
  "Goto line ARG, counting from line 1 at beginning of buffer.
Eli Zaretskii's avatar
Eli Zaretskii committed
747 748 749 750
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.
751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787

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
788 789 790 791 792
  (save-restriction
    (widen)
    (goto-char 1)
    (if (eq selective-display t)
	(re-search-forward "[\n\C-m]" nil 'end (1- arg))
793
      (forward-line (1- arg)))))
Jim Blandy's avatar
Jim Blandy committed
794 795

(defun count-lines-region (start end)
796
  "Print number of lines and characters in the region."
Jim Blandy's avatar
Jim Blandy committed
797 798 799 800 801
  (interactive "r")
  (message "Region has %d lines, %d characters"
	   (count-lines start end) (- end start)))

(defun what-line ()
802
  "Print the current buffer line number and narrowed line number of point."
Jim Blandy's avatar
Jim Blandy committed
803
  (interactive)
804
  (let ((start (point-min))
805
	(n (line-number-at-pos)))
Kim F. Storm's avatar
Kim F. Storm committed
806 807 808 809 810
    (if (= start 1)
	(message "Line %d" n)
      (save-excursion
	(save-restriction
	  (widen)
Luc Teirlinck's avatar
Luc Teirlinck committed
811
	  (message "line %d (narrowed line %d)"
812
		   (+ n (line-number-at-pos start) -1) n))))))
813

Jim Blandy's avatar
Jim Blandy committed
814 815 816
(defun count-lines (start end)
  "Return number of lines between START and END.
This is usually the number of newlines between them,
817
but can be one more if START is not equal to END
Jim Blandy's avatar
Jim Blandy committed
818
and the greater of them is not at the start of a line."
819 820 821 822 823 824
  (save-excursion
    (save-restriction
      (narrow-to-region start end)
      (goto-char (point-min))
      (if (eq selective-display t)
	  (save-match-data
825 826 827 828 829
	    (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)))
830 831 832 833
	      (goto-char (point-max))
	      (if (and (/= start end)
		       (not (bolp)))
		  (1+ done)
834 835
		done)))
	(- (buffer-size) (forward-line (buffer-size)))))))
836

837
(defun line-number-at-pos (&optional pos)
Kim F. Storm's avatar
Kim F. Storm committed
838 839 840 841 842 843 844 845 846 847
  "Return (narrowed) buffer line number at position POS.
If POS is nil, use current buffer location."
  (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))))))

848 849
(defun what-cursor-position (&optional detail)
  "Print info on cursor position (on screen and within buffer).
850
Also describe the character after point, and give its character code
851 852 853 854 855 856 857
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.
858

859
In addition, with prefix argument, show details about that character
860
in *Help* buffer.  See also the command `describe-char'."
861
  (interactive "P")
Jim Blandy's avatar
Jim Blandy committed
862 863 864 865 866 867 868 869 870 871 872 873 874 875 876
  (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)))
877
	    (message "point=%d of %d (%d%%) <%d - %d> column %d %s"
Jim Blandy's avatar
Jim Blandy committed
878
		     pos total percent beg end col hscroll)
879
	  (message "point=%d of %d (%d%%) column %d %s"
Jim Blandy's avatar
Jim Blandy committed
880
		   pos total percent col hscroll))
881 882 883 884 885
      (let ((coding buffer-file-coding-system)
	    encoded encoding-msg)
	(if (or (not coding)
		(eq (coding-system-type coding) t))
	    (setq coding default-buffer-file-coding-system))
886 887 888 889 890 891
	(if (not (char-valid-p char))
	    (setq encoding-msg
		  (format "(0%o, %d, 0x%x, invalid)" char char char))
	  (setq encoded (and (>= char 128) (encode-coding-char char coding)))
	  (setq encoding-msg
		(if encoded
892
		    (format "(0%o, %d, 0x%x, file %s)"
893
			    char char char
894
			    (if (> (length encoded) 1)
895
				"..."
896
			      (encoded-string-description encoded coding)))
897
		  (format "(0%o, %d, 0x%x)" char char char))))
898
	(if detail
899
	    ;; We show the detailed information about CHAR.
900
	    (describe-char (point)))
901 902
	(if (or (/= beg 1) (/= end (1+ total)))
	    (message "Char: %s %s point=%d of %d (%d%%) <%d - %d> column %d %s"
903 904
		     (if (< char 256)
			 (single-key-description char)
905
		       (buffer-substring-no-properties (point) (1+ (point))))
906 907 908 909 910 911
		     encoding-msg pos total percent beg end col hscroll)
	  (message "Char: %s %s point=%d of %d (%d%%) column %d %s"
		   (if (< char 256)
		       (single-key-description char)
		     (buffer-substring-no-properties (point) (1+ (point))))
		   encoding-msg pos total percent col hscroll))))))
912

913 914 915 916 917
(defvar read-expression-map
  (let ((m (make-sparse-keymap)))
    (define-key m "\M-\t" 'lisp-complete-symbol)
    (set-keymap-parent m minibuffer-local-map)
    m)
918 919
  "Minibuffer keymap used for reading Lisp expressions.")

920 921
(defvar read-expression-history nil)

922
(defcustom eval-expression-print-level 4
Dave Love's avatar
Dave Love committed
923
  "*Value to use for `print-level' when printing value in `eval-expression'.
924
A value of nil means no limit."
925
  :group 'lisp
Dave Love's avatar
Dave Love committed
926
  :type '(choice (const :tag "No Limit" nil) integer)
927 928 929
  :version "21.1")

(defcustom eval-expression-print-length 12
Dave Love's avatar
Dave Love committed
930
  "*Value to use for `print-length' when printing value in `eval-expression'.
931
A value of nil means no limit."
932
  :group 'lisp
Dave Love's avatar
Dave Love committed
933
  :type '(choice (const :tag "No Limit" nil) integer)
934 935 936
  :version "21.1")

(defcustom eval-expression-debug-on-error t
937 938
  "*Non-nil means set `debug-on-error' when evaluating in `eval-expression'.
If nil, don't change the value of `debug-on-error'."
939 940 941 942
  :group 'lisp
  :type 'boolean
  :version "21.1")

943 944 945 946 947 948
(defun eval-expression-print-format (value)
  "Format VALUE as a result of evaluated expression.
Return a formatted string which is displayed in the echo area
in addition to the value printed by prin1 in functions which
display the result of expression evaluation."
  (if (and (integerp value)
949
           (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
950
               (eq this-command last-command)
951
               (if (boundp 'edebug-active) edebug-active)))
952
      (let ((char-string
953
             (if (or (if (boundp 'edebug-active) edebug-active)
954
                     (memq this-command '(eval-last-sexp eval-print-last-sexp)))
955 956 957 958 959
                 (prin1-char value))))
        (if char-string
            (format " (0%o, 0x%x) = %s" value value char-string)
          (format " (0%o, 0x%x)" value value)))))

960
;; We define this, rather than making `eval' interactive,
Jim Blandy's avatar
Jim Blandy committed
961
;; for the sake of completion of names like eval-region, eval-current-buffer.
962 963
(defun eval-expression (eval-expression-arg
			&optional eval-expression-insert-value)
Eli Zaretskii's avatar
Eli Zaretskii committed
964 965 966 967 968
  "Evaluate EVAL-EXPRESSION-ARG and print value in the echo area.
Value is also consed on to front of the variable `values'.
Optional argument EVAL-EXPRESSION-INSERT-VALUE, if non-nil, means
insert the result into the current buffer instead of printing it in
the echo area."
969
  (interactive
970 971
   (list (read-from-minibuffer "Eval: "
			       nil read-expression-map t
972 973
			       'read-expression-history)
	 current-prefix-arg))
974

975 976 977 978 979 980 981 982 983 984 985 986
  (if (null eval-expression-debug-on-error)
      (setq values (cons (eval eval-expression-arg) values))
    (let ((old-value (make-symbol "t")) new-value)
      ;; Bind debug-on-error to something unique so that we can
      ;; detect when evaled code changes it.
      (let ((debug-on-error old-value))
	(setq values (cons (eval eval-expression-arg) values))
	(setq new-value debug-on-error))
      ;; If evaled code has changed the value of debug-on-error,
      ;; propagate that change to the global binding.
      (unless (eq old-value new-value)
	(setq debug-on-error new-value))))
987

988 989
  (let ((print-length eval-expression-print-length)
	(print-level eval-expression-print-level))
990 991
    (if eval-expression-insert-value
	(with-no-warnings
992 993
	 (let ((standard-output (current-buffer)))
	   (eval-last-sexp-print-value (car values))))
994 995 996 997
      (prog1
          (prin1 (car values) t)
        (let ((str (eval-expression-print-format (car values))))
          (if str (princ str t)))))))
Jim Blandy's avatar
Jim Blandy committed
998 999 1000 1001 1002

(defun edit-and-eval-command (prompt command)
  "Prompting with PROMPT, let user edit COMMAND and eval result.
COMMAND is a Lisp expression.  Let user edit that expression in
the minibuffer, then read and evaluate the result."
1003
  (let ((command
1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014
	 (let ((print-level nil)
	       (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
	   (unwind-protect
	       (read-from-minibuffer prompt
				     (prin1-to-string command)
				     read-expression-map t
				     'command-history)
	     ;; If command was added to command-history as a string,
	     ;; get rid of that.  We want only evaluable expressions there.
	     (if (stringp (car command-history))
		 (setq command-history (cdr command-history)))))))
1015 1016 1017 1018 1019

    ;; If command to be redone does not match front of history,
    ;; add it to the history.
    (or (equal command (car command-history))
	(setq command-history (cons command command-history)))
Jim Blandy's avatar
Jim Blandy committed
1020 1021
    (eval command)))

1022
(defun repeat-complex-command (arg)
Jim Blandy's avatar
Jim Blandy committed
1023 1024 1025 1026 1027 1028
  "Edit and re-evaluate last complex command, or ARGth from last.
A complex command is one which used the minibuffer.
The command is placed in the minibuffer as a Lisp form for editing.
The result is executed, repeating the command as changed.
If the command has been changed or is not the most recent previous command
it is added to the front of the command history.
1029 1030
You can use the minibuffer history commands \\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
to get different commands to edit and resubmit."
Jim Blandy's avatar
Jim Blandy committed
1031
  (interactive "p")
1032
  (let ((elt (nth (1- arg) command-history))
Jim Blandy's avatar
Jim Blandy committed
1033 1034
	newcmd)
    (if elt
1035
	(progn
1036
	  (setq newcmd
1037 1038
		(let ((print-level nil)
		      (minibuffer-history-position arg)
1039
		      (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
1040 1041 1042 1043 1044 1045 1046 1047 1048 1049
		  (unwind-protect
		      (read-from-minibuffer
		       "Redo: " (prin1-to-string elt) read-expression-map t
		       (cons 'command-history arg))

		    ;; If command was added to command-history as a
		    ;; string, get rid of that.  We want only
		    ;; evaluable expressions there.
		    (if (stringp (car command-history))
			(setq command-history (cdr command-history))))))
1050 1051 1052 1053 1054

	  ;; If command to be redone does not match front of history,
	  ;; add it to the history.
	  (or (equal newcmd (car command-history))
	      (setq command-history (cons newcmd command-history)))
Jim Blandy's avatar
Jim Blandy committed
1055
	  (eval newcmd))
1056 1057 1058
      (if command-history
	  (error "Argument %d is beyond length of command history" arg)
	(error "There are no previous complex commands to repeat")))))
1059

1060 1061 1062 1063 1064
(defvar minibuffer-history nil
  "Default minibuffer history list.
This is used for all minibuffer input
except when an alternate history list is specified.")
(defvar minibuffer-history-sexp-flag nil
1065 1066 1067 1068 1069
  "Control whether history list elements are expressions or strings.
If the value of this variable equals current minibuffer depth,
they are expressions; otherwise they are strings.
\(That convention is designed to do the right thing fora
recursive uses of the minibuffer.)")
1070 1071
(setq