;;; simple.el --- basic editing commands for Emacs
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;; 2000, 2001, 2002, 2003, 2004
+;; 2000, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Maintainer: FSF
(defgroup next-error nil
"next-error support framework."
:group 'compilation
- :version "21.4")
+ :version "22.1")
(defface next-error
'((t (:inherit region)))
"Face used to highlight next error locus."
:group 'next-error
- :version "21.4")
+ :version "22.1")
(defcustom next-error-highlight 0.1
"*Highlighting of locations in selected source buffers.
(const :tag "No highlighting" nil)
(const :tag "Fringe arrow" 'fringe-arrow))
:group 'next-error
- :version "21.4")
+ :version "22.1")
(defcustom next-error-highlight-no-select 0.1
"*Highlighting of locations in non-selected source buffers.
(const :tag "No highlighting" nil)
(const :tag "Fringe arrow" 'fringe-arrow))
:group 'next-error
- :version "21.4")
+ :version "22.1")
(defvar next-error-last-buffer nil
"The most recent next-error buffer.
(make-variable-buffer-local 'next-error-function)
-(defsubst next-error-buffer-p (buffer
- &optional
- extra-test-inclusive
+(defsubst next-error-buffer-p (buffer
+ &optional avoid-current
+ extra-test-inclusive
extra-test-exclusive)
"Test if BUFFER is a next-error capable buffer.
-EXTRA-TEST-INCLUSIVE is called to allow extra buffers.
-EXTRA-TEST-INCLUSIVE is called to disallow buffers."
- (with-current-buffer buffer
- (or (and extra-test-inclusive (funcall extra-test-inclusive))
- (and (if extra-test-exclusive (funcall extra-test-exclusive) t)
- next-error-function))))
-
-(defun next-error-find-buffer (&optional other-buffer
- extra-test-inclusive
+
+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
+ extra-test-inclusive
extra-test-exclusive)
"Return a next-error capable buffer.
-OTHER-BUFFER will disallow the current buffer.
-EXTRA-TEST-INCLUSIVE is called to allow extra buffers.
-EXTRA-TEST-INCLUSIVE is called to disallow buffers."
+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."
(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
- (window-buffer w)
- extra-test-inclusive extra-test-exclusive)
+ (window-buffer w)
+ avoid-current
+ extra-test-inclusive extra-test-exclusive)
(window-buffer w)))
(window-list))))))
- (if other-buffer
- (setq window-buffers (delq (current-buffer) window-buffers)))
(if (eq (length window-buffers) 1)
(car window-buffers)))
- ;; 2. If next-error-last-buffer is set to a live buffer, use that.
+ ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
(if (and next-error-last-buffer
- (buffer-name next-error-last-buffer)
- (next-error-buffer-p next-error-last-buffer
- extra-test-inclusive extra-test-exclusive)
- (or (not other-buffer)
- (not (eq next-error-last-buffer (current-buffer)))))
+ (next-error-buffer-p next-error-last-buffer avoid-current
+ extra-test-inclusive extra-test-exclusive))
next-error-last-buffer)
- ;; 3. If the current buffer is a next-error capable buffer, return it.
- (if (and (not other-buffer)
- (next-error-buffer-p (current-buffer)
- extra-test-inclusive extra-test-exclusive))
+ ;; 3. If the current buffer is acceptable, choose it.
+ (if (next-error-buffer-p (current-buffer) avoid-current
+ extra-test-inclusive extra-test-exclusive)
(current-buffer))
- ;; 4. Look for a next-error capable buffer in a buffer list.
+ ;; 4. Look for any acceptable buffer.
(let ((buffers (buffer-list)))
(while (and buffers
- (or (not (next-error-buffer-p
- (car buffers)
- extra-test-inclusive extra-test-exclusive))
- (and other-buffer (eq (car buffers) (current-buffer)))))
+ (not (next-error-buffer-p
+ (car buffers) avoid-current
+ extra-test-inclusive extra-test-exclusive)))
(setq buffers (cdr buffers)))
- (if buffers
- (car buffers)
- (or (and other-buffer
- (next-error-buffer-p (current-buffer)
- extra-test-inclusive extra-test-exclusive)
- ;; The current buffer is a next-error capable buffer.
- (progn
- (if other-buffer
- (message "This is the only next-error capable buffer"))
- (current-buffer)))
- (error "No next-error capable buffer found"))))))
+ (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")))
(defun next-error (&optional arg reset)
"Visit next next-error message and corresponding source code.
(skip-chars-backward " \t")
(constrain-to-field nil orig-pos)))))
-(defun just-one-space ()
- "Delete all spaces and tabs around point, leaving one space."
- (interactive "*")
+(defun just-one-space (&optional n)
+ "Delete all spaces and tabs around point, leaving one space (or N spaces)."
+ (interactive "*p")
(let ((orig-pos (point)))
(skip-chars-backward " \t")
(constrain-to-field nil orig-pos)
- (if (= (following-char) ? )
- (forward-char 1)
- (insert ? ))
+ (dotimes (i (or n 1))
+ (if (= (following-char) ?\ )
+ (forward-char 1)
+ (insert ?\ )))
(delete-region
(point)
(progn
(skip-chars-forward " \t")
(constrain-to-field nil orig-pos t)))))
\f
-(defvar inhibit-mark-movement nil
- "If non-nil, \\[beginning-of-buffer] and \\[end-of-buffer] does not set the mark.")
-
(defun beginning-of-buffer (&optional arg)
"Move point to the beginning of the buffer; leave mark at previous position.
With \\[universal-argument] prefix, do not set mark at previous position.
Don't use this command in Lisp programs!
\(goto-char (point-min)) is faster and avoids clobbering the mark."
(interactive "P")
- (unless (or inhibit-mark-movement (consp arg))
- (push-mark))
+ (or (consp arg)
+ (and transient-mark-mode mark-active)
+ (push-mark))
(let ((size (- (point-max) (point-min))))
(goto-char (if (and arg (not (consp arg)))
(+ (point-min)
Don't use this command in Lisp programs!
\(goto-char (point-max)) is faster and avoids clobbering the mark."
(interactive "P")
- (unless (or inhibit-mark-movement (consp arg))
- (push-mark))
+ (or (consp arg)
+ (and transient-mark-mode mark-active)
+ (push-mark))
(let ((size (- (point-max) (point-min))))
(goto-char (if (and arg (not (consp arg)))
(- (point-max)
(if (and (integerp value)
(or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
(eq this-command last-command)
- (and (boundp 'edebug-active) edebug-active)))
+ (if (boundp 'edebug-active) edebug-active)))
(let ((char-string
(if (or (and (boundp 'edebug-active) edebug-active)
(memq this-command '(eval-last-sexp eval-print-last-sexp)))
nil
minibuffer-local-map
nil
- 'minibuffer-history-search-history)))
+ 'minibuffer-history-search-history
+ (car minibuffer-history-search-history))))
;; Use the last regexp specified, by default, if input is empty.
(list (if (string= regexp "")
- (setcar minibuffer-history-search-history
- (nth 1 minibuffer-history-search-history))
+ (if minibuffer-history-search-history
+ (car minibuffer-history-search-history)
+ (error "No previous history search regexp"))
regexp)
(prefix-numeric-value current-prefix-arg))))
(previous-matching-history-element regexp (- n)))
(defvar undo-no-redo nil
"If t, `undo' doesn't go through redo entries.")
+(defvar pending-undo-list nil
+ "Within a run of consecutive undo commands, list remaining to be undone.
+t if we undid all the way to the end of it.")
+
(defun undo (&optional arg)
"Undo some previous changes.
Repeat this command to undo more changes.
;; So set `this-command' to something other than `undo'.
(setq this-command 'undo-start)
- (unless (eq last-command 'undo)
+ (unless (and (eq last-command 'undo)
+ (or (eq pending-undo-list t)
+ ;; If something (a timer or filter?) changed the buffer
+ ;; since the previous command, don't continue the undo seq.
+ (let ((list buffer-undo-list))
+ (while (eq (car list) nil)
+ (setq list (cdr list)))
+ ;; If the last undo record made was made by undo
+ ;; it shows nothing else happened in between.
+ (gethash list undo-equiv-table))))
(setq undo-in-region
(if transient-mark-mode mark-active (and arg (not (numberp arg)))))
(if undo-in-region
(setq tail (cdr tail)))
(setq tail nil)))
(setq prev tail tail (cdr tail))))
-
+ ;; Record what the current undo list says,
+ ;; so the next command can tell if the buffer was modified in between.
(and modified (not (buffer-modified-p))
(delete-auto-save-file-if-necessary recent-save))))
+(defun buffer-disable-undo (&optional buffer)
+ "Make BUFFER stop keeping undo information.
+No argument or nil as argument means do this for the current buffer."
+ (interactive)
+ (with-current-buffer (if buffer (get-buffer buffer) (current-buffer))
+ (setq buffer-undo-list t)))
+
(defun undo-only (&optional arg)
"Undo some previous changes.
Repeat this command to undo more changes.
;; no idea whereas to bind it. Any suggestion welcome. -stef
;; (define-key ctl-x-map "U" 'undo-only)
-(defvar pending-undo-list nil
- "Within a run of consecutive undo commands, list remaining to be undone.")
-
(defvar undo-in-progress nil
"Non-nil while performing an undo.
Some change-hooks test this variable to do something different.")
"Undo back N undo-boundaries beyond what was already undone recently.
Call `undo-start' to get ready to undo recent changes,
then call `undo-more' one or more times to undo them."
- (or pending-undo-list
+ (or (listp pending-undo-list)
(error (format "No further undo information%s"
(if (and transient-mark-mode mark-active)
" for region" ""))))
(let ((undo-in-progress t))
- (setq pending-undo-list (primitive-undo count pending-undo-list))))
+ (setq pending-undo-list (primitive-undo count pending-undo-list))
+ (if (null pending-undo-list)
+ (setq pending-undo-list t))))
;; Deep copy of a list
(defun undo-copy-list (list)
(t
'(0 . 0)))
'(0 . 0)))
+
+(defcustom undo-ask-before-discard t
+ "If non-nil ask about discarding undo info for the current command.
+Normally, Emacs discards the undo info for the current command if
+it exceeds `undo-outer-limit'. But if you set this option
+non-nil, it asks in the echo area whether to discard the info.
+If you answer no, there a slight risk that Emacs might crash, so
+only do it if you really want to undo the command.
+
+This option is mainly intended for debugging. You have to be
+careful if you use it for other purposes. Garbage collection is
+inhibited while the question is asked, meaning that Emacs might
+leak memory. So you should make sure that you do not wait
+excessively long before answering the question."
+ :type 'boolean
+ :group 'undo
+ :version "22.1")
+
+(defvar undo-extra-outer-limit nil
+ "If non-nil, an extra level of size that's ok in an undo item.
+We don't ask the user about truncating the undo list until the
+current item gets bigger than this amount.
+
+This variable only matters if `undo-ask-before-discard' is non-nil.")
+(make-variable-buffer-local 'undo-extra-outer-limit)
+
+;; When the first undo batch in an undo list is longer than
+;; undo-outer-limit, this function gets called to warn the user that
+;; the undo info for the current command was discarded. Garbage
+;; collection is inhibited around the call, so it had better not do a
+;; lot of consing.
+(setq undo-outer-limit-function 'undo-outer-limit-truncate)
+(defun undo-outer-limit-truncate (size)
+ (if undo-ask-before-discard
+ (when (or (null undo-extra-outer-limit)
+ (> size undo-extra-outer-limit))
+ ;; Don't ask the question again unless it gets even bigger.
+ ;; This applies, in particular, if the user quits from the question.
+ ;; Such a quit quits out of GC, but something else will call GC
+ ;; again momentarily. It will call this function again,
+ ;; but we don't want to ask the question again.
+ (setq undo-extra-outer-limit (+ size 50000))
+ (if (let (use-dialog-box track-mouse executing-kbd-macro )
+ (yes-or-no-p (format "Buffer %s undo info is %d bytes long; discard it? "
+ (buffer-name) size)))
+ (progn (setq buffer-undo-list nil)
+ (setq undo-extra-outer-limit nil)
+ t)
+ nil))
+ (display-warning '(undo discard-info)
+ (concat
+ (format "Buffer %s undo info was %d bytes long.\n"
+ (buffer-name) size)
+ "The undo info was discarded because it exceeded \
+`undo-outer-limit'.
+
+This is normal if you executed a command that made a huge change
+to the buffer. In that case, to prevent similar problems in the
+future, set `undo-outer-limit' to a value that is large enough to
+cover the maximum size of normal changes you expect a single
+command to make, but not so large that it might exceed the
+maximum memory allotted to Emacs.
+
+If you did not execute any such command, the situation is
+probably due to a bug and you should report it.
+
+You can disable the popping up of this buffer by adding the entry
+\(undo discard-info) to the user option `warning-suppress-types'.\n")
+ :warning)
+ (setq buffer-undo-list nil)
+ t))
\f
(defvar shell-command-history nil
"History list for some commands that read shell commands.")
which means to discard all text properties."
:type '(choice (const :tag "All" t) (repeat symbol))
:group 'killing
- :version "21.4")
+ :version "22.1")
(defvar yank-window-start nil)
(defvar yank-undo-function nil
(when mark-ring
(setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
(set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
- (deactivate-mark)
(move-marker (car mark-ring) nil)
(if (null (mark t)) (ding))
- (setq mark-ring (cdr mark-ring))))
+ (setq mark-ring (cdr mark-ring)))
+ (deactivate-mark))
(defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
(defun exchange-point-and-mark (&optional arg)
Many commands change their behavior when Transient Mark mode is in effect
and the mark is active, by acting on the region instead of their usual
default part of the buffer's text. Examples of such commands include
-\\[comment-dwim], \\[flush-lines], \\[ispell], \\[keep-lines],
-\\[query-replace], \\[query-replace-regexp], and \\[undo]. Invoke
-\\[apropos-documentation] and type \"transient\" or \"mark.*active\" at
-the prompt, to see the documentation of commands which are sensitive to
-the Transient Mark mode."
+\\[comment-dwim], \\[flush-lines], \\[keep-lines], \
+\\[query-replace], \\[query-replace-regexp], \\[ispell], and \\[undo].
+Invoke \\[apropos-documentation] and type \"transient\" or
+\"mark.*active\" at the prompt, to see the documentation of
+commands which are sensitive to the Transient Mark mode."
:global t :group 'editing-basics :require nil)
(defun pop-global-mark ()
(or (memq prop buffer-invisibility-spec)
(assq prop buffer-invisibility-spec)))))
+;; Perform vertical scrolling of tall images if necessary.
+(defun line-move (arg &optional noerror to-end)
+ (if auto-window-vscroll
+ (let ((forward (> arg 0))
+ (part (nth 2 (pos-visible-in-window-p (point) nil t))))
+ (if (and (consp part)
+ (> (setq part (if forward (cdr part) (car part))) 0))
+ (set-window-vscroll nil
+ (if forward
+ (+ (window-vscroll nil t)
+ (min part
+ (* (frame-char-height) arg)))
+ (max 0
+ (- (window-vscroll nil t)
+ (min part
+ (* (frame-char-height) (- arg))))))
+ t)
+ (set-window-vscroll nil 0)
+ (line-move-1 arg noerror to-end)))
+ (line-move-1 arg noerror to-end)))
+
;; This is the guts of next-line and previous-line.
;; Arg says how many lines to move.
;; The value is t if we can move the specified number of lines.
-(defun line-move (arg &optional noerror to-end)
+(defun line-move-1 (arg &optional noerror to-end)
;; Don't run any point-motion hooks, and disregard intangibility,
;; for intermediate positions.
(let ((inhibit-point-motion-hooks t)
(if (if forward
;; If going forward, don't accept the previous
;; allowable position if it is before the target line.
- (< line-beg (point))
+ (< line-beg (point))
;; If going backward, don't accept the previous
;; allowable position if it is still after the target line.
(<= (point) line-end))
(interactive "p")
(forward-word (- (or arg 1))))
-(defun mark-word (arg)
- "Set mark arg words away from point.
-If this command is repeated, it marks the next ARG words after the ones
-already marked."
- (interactive "p")
- (cond ((and (eq last-command this-command) (mark t))
+(defun mark-word (&optional arg allow-extend)
+ "Set mark ARG words away from point.
+The place mark goes is the same place \\[forward-word] would
+move to with the same argument.
+Interactively, if this command is repeated
+or (in Transient Mark mode) if the mark is active,
+it marks the next ARG words after the ones already marked."
+ (interactive "P\np")
+ (cond ((and allow-extend
+ (or (and (eq last-command this-command) (mark t))
+ (and transient-mark-mode mark-active)))
+ (setq arg (if arg (prefix-numeric-value arg)
+ (if (< (mark) (point)) -1 1)))
(set-mark
(save-excursion
(goto-char (mark))
(t
(push-mark
(save-excursion
- (forward-word arg)
+ (forward-word (prefix-numeric-value arg))
(point))
nil t))))
(setq matching-paren
(let ((syntax (syntax-after blinkpos)))
(and (consp syntax)
- (eq (car syntax) 4)
+ (eq (logand (car syntax) 255) 4)
(cdr syntax)))
mismatch
(or (null matching-paren)
(abort-recursive-edit))
(current-prefix-arg
nil)
- ((and transient-mark-mode
- mark-active)
+ ((and transient-mark-mode mark-active)
(deactivate-mark))
((> (recursion-depth) 0)
(exit-recursive-edit))
(play-sound sound)))
(define-key global-map "\e\e\e" 'keyboard-escape-quit)
-
+\f
(defcustom read-mail-command 'rmail
"*Your preference for a mail reading package.
This is used by some keybindings which support reading mail.
(list nil nil nil current-prefix-arg))
(compose-mail to subject other-headers continue
'switch-to-buffer-other-frame yank-action send-actions))
-
+\f
(defvar set-variable-value-history nil
"History of values entered with `set-variable'.")
;; Force a thorough redisplay for the case that the variable
;; has an effect on the display, like `tab-width' has.
(force-mode-line-update))
-
+\f
;; Define the major mode for lists of completions.
(defvar completion-list-mode-map nil
(or completion-list-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'mouse-choose-completion)
+ (define-key map [follow-link] 'mouse-face)
(define-key map [down-mouse-2] nil)
(define-key map "\C-m" 'choose-completion)
(define-key map "\e\e\e" 'delete-completion-window)
wait this many seconds after Emacs becomes idle before doing an update."
:type 'number
:group 'display
- :version "21.4")
+ :version "22.1")
\f
(defvar vis-mode-saved-buffer-invisibility-spec nil
"Saved value of `buffer-invisibility-spec' when Visible mode is on.")