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

3 4
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
;;               2000, 2001, 2002, 2003, 2004
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
(defgroup killing nil
40
  "Killing and yanking commands."
41 42 43 44 45 46
  :group 'editing)

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

47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
(define-key global-map [?\C-x right] 'next-buffer)
(define-key global-map [?\C-x left] 'prev-buffer)
(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)))
68

69
;;; next-error support framework
70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107

(defgroup next-error nil
  "next-error support framework."
  :group 'compilation
  :version "21.4")

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

(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
  :version "21.4")

(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
  :version "21.4")

108 109 110 111 112 113 114
(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
115 116 117 118 119 120 121 122
  "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.")
123 124 125

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

126
(defsubst next-error-buffer-p (buffer
127
			       &optional avoid-current
128
			       extra-test-inclusive
129 130
			       extra-test-exclusive)
  "Test if BUFFER is a next-error capable buffer.
131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154

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
155
					 extra-test-inclusive
156 157
					 extra-test-exclusive)
  "Return a next-error capable buffer.
158 159 160 161 162 163 164 165 166 167
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."
168 169 170 171 172 173
  (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
174 175
				    (window-buffer w)
                                    avoid-current
176
                                    extra-test-inclusive extra-test-exclusive)
177 178 179 180
                                   (window-buffer w)))
                             (window-list))))))
     (if (eq (length window-buffers) 1)
         (car window-buffers)))
181
   ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
182
   (if (and next-error-last-buffer
183
            (next-error-buffer-p next-error-last-buffer avoid-current
184
                                 extra-test-inclusive extra-test-exclusive))
185 186 187 188
       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)
189
       (current-buffer))
190
   ;; 4. Look for any acceptable buffer.
191 192
   (let ((buffers (buffer-list)))
     (while (and buffers
193 194 195
                 (not (next-error-buffer-p
		       (car buffers) avoid-current
		       extra-test-inclusive extra-test-exclusive)))
196
       (setq buffers (cdr buffers)))
197 198 199 200 201 202 203 204 205 206 207
     (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")))
208

209
(defun next-error (&optional arg reset)
210 211 212 213 214
  "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.

215
A prefix ARG specifies how many error messages to move;
216 217 218 219
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.

220
The RESET argument specifies that we should restart from the beginning.
221 222 223 224 225 226

\\[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
227 228 229 230
`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.
231 232 233 234 235 236 237 238

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")
239
  (if (consp arg) (setq reset t arg nil))
240 241 242
  (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
243
      (funcall next-error-function (prefix-numeric-value arg) reset))))
244 245 246 247 248 249

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

(define-key ctl-x-map "`" 'next-error)

250
(defun previous-error (&optional n)
251 252 253 254 255 256 257
  "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")
258
  (next-error (- (or n 1))))
259

260
(defun first-error (&optional n)
261 262 263 264 265 266 267
  "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))

268
(defun next-error-no-select (&optional n)
269 270 271 272 273 274
  "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")
275 276
  (let ((next-error-highlight next-error-highlight-no-select))
    (next-error n))
277 278
  (pop-to-buffer next-error-last-buffer))

279
(defun previous-error-no-select (&optional n)
280 281 282 283 284 285
  "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")
286
  (next-error-no-select (- (or n 1))))
287

288 289 290
;;; Internal variable for `next-error-follow-mode-post-command-hook'.
(defvar next-error-follow-last-line nil)

Eli Zaretskii's avatar
Eli Zaretskii committed
291
(define-minor-mode next-error-follow-minor-mode
292
  "Minor mode for compilation, occur and diff modes.
Eli Zaretskii's avatar
Eli Zaretskii committed
293 294 295
When turned on, cursor motion in the compilation, grep, occur or diff
buffer causes automatic display of the corresponding source code
location."
296
  nil " Fol" nil
297
  (if (not next-error-follow-minor-mode)
298 299 300 301 302 303 304 305 306 307 308 309 310 311 312
      (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))))

313

314 315
;;;

Karl Heuer's avatar
Karl Heuer committed
316 317 318 319
(defun fundamental-mode ()
  "Major mode not specialized for anything in particular.
Other major modes are defined by comparison with this one."
  (interactive)
320 321
  (kill-all-local-variables)
  (run-hooks 'after-change-major-mode-hook))
322

Karl Heuer's avatar
Karl Heuer committed
323 324
;; Making and deleting lines.

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

382 383
    ;; Mark the newline(s) `hard'.
    (if use-hard-newlines
384
	(set-hard-newline-properties
385
	 (- (point) (if arg (prefix-numeric-value arg) 1)) (point)))
386 387 388 389 390 391 392 393 394 395 396 397 398 399
    ;; 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)))
400 401
  nil)

402 403 404 405 406 407 408
(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)))))
409

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

432 433 434
(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
435
line as well.  With prefix ARG, don't insert fill-prefix on new line.
436

437
When called from Lisp code, ARG may be a prefix string to copy."
438
  (interactive "*P")
Jim Blandy's avatar
Jim Blandy committed
439
  (skip-chars-forward " \t")
440 441 442 443 444 445 446 447 448 449 450
  (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))))))
451
    (newline 1)
452
    (if have-prfx (insert-and-inherit prefix))
Jim Blandy's avatar
Jim Blandy committed
453 454 455 456 457
    (indent-to col 0)
    (goto-char pos)))

(defun delete-indentation (&optional arg)
  "Join this line to previous and fix up whitespace at join.
458
If there is a fill prefix, delete it from the beginning of this line.
Jim Blandy's avatar
Jim Blandy committed
459 460 461 462 463 464 465
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)))
466 467 468
	;; If the second line started with the fill prefix,
	;; delete the prefix.
	(if (and fill-prefix
469
		 (<= (+ (point) (length fill-prefix)) (point-max))
470 471 472 473
		 (string= fill-prefix
			  (buffer-substring (point)
					    (+ (point) (length fill-prefix)))))
	    (delete-region (point) (+ (point) (length fill-prefix))))
Jim Blandy's avatar
Jim Blandy committed
474 475
	(fixup-whitespace))))

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

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

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

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

Karl Heuer's avatar
Karl Heuer committed
564 565 566
(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
567

Karl Heuer's avatar
Karl Heuer committed
568 569 570 571 572 573
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.
574

Karl Heuer's avatar
Karl Heuer committed
575 576 577 578
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.
579

Karl Heuer's avatar
Karl Heuer committed
580 581 582 583
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")
584
  (let* ((char (let (translation-table-for-input)
585 586 587 588
		 (if (or (not overwrite-mode)
			 (eq overwrite-mode 'overwrite-mode-binary))
		     (read-quoted-char)
		   (read-char)))))
Karl Heuer's avatar
Karl Heuer committed
589 590 591 592 593 594 595 596 597 598 599 600 601
    ;; 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)))))
602

603
(defun forward-to-indentation (&optional arg)
Karl Heuer's avatar
Karl Heuer committed
604 605
  "Move forward ARG lines and position at first nonblank character."
  (interactive "p")
606
  (forward-line (or arg 1))
Karl Heuer's avatar
Karl Heuer committed
607
  (skip-chars-forward " \t"))
608

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

Karl Heuer's avatar
Karl Heuer committed
615 616 617 618
(defun back-to-indentation ()
  "Move point to the first non-whitespace character on this line."
  (interactive)
  (beginning-of-line 1)
619
  (skip-syntax-forward " " (line-end-position))
620 621
  ;; Move back over chars that have whitespace syntax but have the p flag.
  (backward-prefix-chars))
Karl Heuer's avatar
Karl Heuer committed
622 623 624 625 626 627 628 629 630 631 632 633 634

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

635 636 637
(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
638
  (interactive "*")
639 640 641 642 643 644 645
  (let ((orig-pos (point)))
    (delete-region
     (if backward-only
	 orig-pos
       (progn
	 (skip-chars-forward " \t")
	 (constrain-to-field nil orig-pos t)))
646
     (progn
647 648
       (skip-chars-backward " \t")
       (constrain-to-field nil orig-pos)))))
Karl Heuer's avatar
Karl Heuer committed
649 650 651 652

(defun just-one-space ()
  "Delete all spaces and tabs around point, leaving one space."
  (interactive "*")
653 654 655 656 657 658 659 660 661 662 663
  (let ((orig-pos (point)))
    (skip-chars-backward " \t")
    (constrain-to-field nil orig-pos)
    (if (= (following-char) ? )
	(forward-char 1)
      (insert ? ))
    (delete-region
     (point)
     (progn
       (skip-chars-forward " \t")
       (constrain-to-field nil orig-pos t)))))
664

Jim Blandy's avatar
Jim Blandy committed
665 666
(defun beginning-of-buffer (&optional arg)
  "Move point to the beginning of the buffer; leave mark at previous position.
667 668
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.
669 670 671

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

Don't use this command in Lisp programs!
Jim Blandy's avatar
Jim Blandy committed
674 675
\(goto-char (point-min)) is faster and avoids clobbering the mark."
  (interactive "P")
676
  (or (consp arg)
677 678
      (and transient-mark-mode mark-active)
      (push-mark))
679
  (let ((size (- (point-max) (point-min))))
680
    (goto-char (if (and arg (not (consp arg)))
681 682 683 684 685 686 687
		   (+ (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
688 689 690 691
  (if arg (forward-line 1)))

(defun end-of-buffer (&optional arg)
  "Move point to the end of the buffer; leave mark at previous position.
692 693
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.
694 695 696

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

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

(defun mark-whole-buffer ()
Jim Blandy's avatar
Jim Blandy committed
723 724 725 726
  "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
727 728
  (interactive)
  (push-mark (point))
729
  (push-mark (point-max) nil t)
Jim Blandy's avatar
Jim Blandy committed
730
  (goto-char (point-min)))
731

732

Karl Heuer's avatar
Karl Heuer committed
733 734 735 736 737 738 739 740 741 742 743 744
;; Counting lines, one way or another.

(defun goto-line (arg)
  "Goto line ARG, counting from line 1 at beginning of buffer."
  (interactive "NGoto line: ")
  (setq arg (prefix-numeric-value arg))
  (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
745 746

(defun count-lines-region (start end)
747
  "Print number of lines and characters in the region."
Jim Blandy's avatar
Jim Blandy committed
748 749 750 751 752
  (interactive "r")
  (message "Region has %d lines, %d characters"
	   (count-lines start end) (- end start)))

(defun what-line ()
753
  "Print the current buffer line number and narrowed line number of point."
Jim Blandy's avatar
Jim Blandy committed
754
  (interactive)
755
  (let ((start (point-min))
756
	(n (line-number-at-pos)))
Kim F. Storm's avatar
Kim F. Storm committed
757 758 759 760 761
    (if (= start 1)
	(message "Line %d" n)
      (save-excursion
	(save-restriction
	  (widen)
Luc Teirlinck's avatar
Luc Teirlinck committed
762
	  (message "line %d (narrowed line %d)"
763
		   (+ n (line-number-at-pos start) -1) n))))))
764

Jim Blandy's avatar
Jim Blandy committed
765 766 767
(defun count-lines (start end)
  "Return number of lines between START and END.
This is usually the number of newlines between them,
768
but can be one more if START is not equal to END
Jim Blandy's avatar
Jim Blandy committed
769
and the greater of them is not at the start of a line."
770 771 772 773 774 775
  (save-excursion
    (save-restriction
      (narrow-to-region start end)
      (goto-char (point-min))
      (if (eq selective-display t)
	  (save-match-data
776 777 778 779 780
	    (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)))
781 782 783 784
	      (goto-char (point-max))
	      (if (and (/= start end)
		       (not (bolp)))
		  (1+ done)
785 786
		done)))
	(- (buffer-size) (forward-line (buffer-size)))))))
787

788
(defun line-number-at-pos (&optional pos)
Kim F. Storm's avatar
Kim F. Storm committed
789 790 791 792 793 794 795 796 797 798
  "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))))))

799 800
(defun what-cursor-position (&optional detail)
  "Print info on cursor position (on screen and within buffer).
801
Also describe the character after point, and give its character code
802 803 804 805 806 807 808
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.
809

810
In addition, with prefix argument, show details about that character
811
in *Help* buffer.  See also the command `describe-char'."
812
  (interactive "P")
Jim Blandy's avatar
Jim Blandy committed
813 814 815 816 817 818 819 820 821 822 823 824 825 826 827
  (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)))
828
	    (message "point=%d of %d (%d%%) <%d - %d> column %d %s"
Jim Blandy's avatar
Jim Blandy committed
829
		     pos total percent beg end col hscroll)
830
	  (message "point=%d of %d (%d%%) column %d %s"
Jim Blandy's avatar
Jim Blandy committed
831
		   pos total percent col hscroll))
832 833 834 835 836
      (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))
837 838 839 840 841 842
	(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
843
		    (format "(0%o, %d, 0x%x, file %s)"
844
			    char char char
845
			    (if (> (length encoded) 1)
846
				"..."
847
			      (encoded-string-description encoded coding)))
848
		  (format "(0%o, %d, 0x%x)" char char char))))
849
	(if detail
850
	    ;; We show the detailed information about CHAR.
851
	    (describe-char (point)))
852 853
	(if (or (/= beg 1) (/= end (1+ total)))
	    (message "Char: %s %s point=%d of %d (%d%%) <%d - %d> column %d %s"
854 855
		     (if (< char 256)
			 (single-key-description char)
856
		       (buffer-substring-no-properties (point) (1+ (point))))
857 858 859 860 861 862
		     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))))))
863

864 865 866 867 868
(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)
869 870
  "Minibuffer keymap used for reading Lisp expressions.")

871 872
(defvar read-expression-history nil)

873
(defcustom eval-expression-print-level 4
Dave Love's avatar
Dave Love committed
874
  "*Value to use for `print-level' when printing value in `eval-expression'.
875
A value of nil means no limit."
876
  :group 'lisp
Dave Love's avatar
Dave Love committed
877
  :type '(choice (const :tag "No Limit" nil) integer)
878 879 880
  :version "21.1")

(defcustom eval-expression-print-length 12
Dave Love's avatar
Dave Love committed
881
  "*Value to use for `print-length' when printing value in `eval-expression'.
882
A value of nil means no limit."
883
  :group 'lisp
Dave Love's avatar
Dave Love committed
884
  :type '(choice (const :tag "No Limit" nil) integer)
885 886 887
  :version "21.1")

(defcustom eval-expression-debug-on-error t
888 889
  "*Non-nil means set `debug-on-error' when evaluating in `eval-expression'.
If nil, don't change the value of `debug-on-error'."
890 891 892 893
  :group 'lisp
  :type 'boolean
  :version "21.1")

894 895 896 897 898 899
(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)
900
           (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
901 902 903 904
               (eq this-command last-command)
               (and (boundp 'edebug-active) edebug-active)))
      (let ((char-string
             (if (or (and (boundp 'edebug-active) edebug-active)
905
                     (memq this-command '(eval-last-sexp eval-print-last-sexp)))
906 907 908 909 910
                 (prin1-char value))))
        (if char-string
            (format " (0%o, 0x%x) = %s" value value char-string)
          (format " (0%o, 0x%x)" value value)))))

911
;; We define this, rather than making `eval' interactive,
Jim Blandy's avatar
Jim Blandy committed
912
;; for the sake of completion of names like eval-region, eval-current-buffer.
913 914
(defun eval-expression (eval-expression-arg
			&optional eval-expression-insert-value)
Eli Zaretskii's avatar
Eli Zaretskii committed
915 916 917 918 919
  "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."
920
  (interactive
921 922
   (list (read-from-minibuffer "Eval: "
			       nil read-expression-map t
923 924
			       'read-expression-history)
	 current-prefix-arg))
925

926 927 928 929 930 931 932 933 934 935 936 937
  (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))))
938

939 940
  (let ((print-length eval-expression-print-length)
	(print-level eval-expression-print-level))
941 942
    (if eval-expression-insert-value
	(with-no-warnings
943 944
	 (let ((standard-output (current-buffer)))
	   (eval-last-sexp-print-value (car values))))
945 946 947 948
      (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
949 950 951 952 953

(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."
954
  (let ((command
955 956 957 958 959 960 961 962 963 964 965
	 (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)))))))
966 967 968 969 970

    ;; 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
971 972
    (eval command)))

973
(defun repeat-complex-command (arg)
Jim Blandy's avatar
Jim Blandy committed
974 975 976 977 978 979
  "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.
980 981
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
982
  (interactive "p")
983
  (let ((elt (nth (1- arg) command-history))
Jim Blandy's avatar
Jim Blandy committed
984 985
	newcmd)
    (if elt
986
	(progn
987
	  (setq newcmd
988 989
		(let ((print-level nil)
		      (minibuffer-history-position arg)
990
		      (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
991 992 993 994 995 996 997 998 999 1000
		  (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))))))
1001 1002 1003 1004 1005

	  ;; If command to be redone does not match front of history,
	  ;; add it to the history.
	  (or (equal newcmd (car command-history))