(describe-mode): Allow minor mode toggles to use a different
[bpt/emacs.git] / lisp / simple.el
index 82ec0e6..d3624fc 100644 (file)
@@ -1,7 +1,7 @@
 ;;; 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.
@@ -90,7 +90,7 @@ If `fringe-arrow', indicate the locus by the fringe arrow."
                  (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.
@@ -103,7 +103,7 @@ If `fringe-arrow', indicate the locus by the fringe arrow."
                  (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.
@@ -647,13 +647,13 @@ If BACKWARD-ONLY is non-nil, only delete spaces before point."
        (skip-chars-backward " \t")
        (constrain-to-field nil orig-pos)))))
 
-(defun just-one-space (n)
+(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)
-    (dotimes (i n)
+    (dotimes (i (or n 1))
       (if (= (following-char) ?\ )
          (forward-char 1)
        (insert ?\ )))
@@ -733,10 +733,48 @@ that uses or sets the mark."
 
 ;; 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))
+(defun goto-line (arg &optional buffer)
+  "Goto line ARG, counting from line 1 at beginning of buffer.
+Normally, move point in the curren buffer.
+With just C-u as argument, move point in the most recently displayed
+other buffer, and switch to it.
+
+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.
   (save-restriction
     (widen)
     (goto-char 1)
@@ -902,7 +940,7 @@ display the result of expression evaluation."
                (eq this-command last-command)
                (if (boundp 'edebug-active) edebug-active)))
       (let ((char-string
-             (if (or (and (boundp 'edebug-active) edebug-active)
+             (if (or (if (boundp 'edebug-active) edebug-active)
                      (memq this-command '(eval-last-sexp eval-print-last-sexp)))
                  (prin1-char value))))
         (if char-string
@@ -1235,6 +1273,10 @@ Return 0 if current buffer is not a mini-buffer."
 (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.
@@ -1258,14 +1300,15 @@ as an argument limits undo to changes within the current region."
     (setq this-command 'undo-start)
 
     (unless (and (eq last-command 'undo)
-                ;; 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)))
+                (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
@@ -1340,9 +1383,6 @@ Contrary to `undo', this will not redo a previous undo."
 ;; 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.")
@@ -1351,12 +1391,14 @@ 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)
@@ -1521,33 +1563,76 @@ is not *inside* the region START...END."
             '(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.")
+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 ask the user what to do.
-;; Garbage collection is inhibited around the call,
-;; so it had better not do a lot of consing.
+;; 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)
-  (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)
-         (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)))
+  (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.")
@@ -2414,7 +2499,7 @@ The value should be a list of text properties to discard or t,
 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
@@ -2828,6 +2913,14 @@ START and END specify the portion of the current buffer to be copied."
 (put 'mark-inactive 'error-conditions '(mark-inactive error))
 (put 'mark-inactive 'error-message "The mark is not active now")
 
+(defvar activate-mark-hook nil
+  "Hook run when the mark becomes active.
+It is also run at the end of a command, if the mark is active and
+it is possible that the region may have changed")
+
+(defvar deactivate-mark-hook nil
+  "Hook run when the mark becomes inactive.")
+
 (defun mark (&optional force)
   "Return this buffer's mark value as integer; error if mark inactive.
 If optional argument FORCE is non-nil, access the mark value
@@ -2919,6 +3012,7 @@ Display `Mark set' unless the optional second arg NOMSG is non-nil."
     (if (or arg (null mark) (/= mark (point)))
        (push-mark nil nomsg t)
       (setq mark-active t)
+      (run-hooks 'activate-mark-hook)
       (unless nomsg
        (message "Mark activated")))))
 
@@ -3083,8 +3177,9 @@ commands which are sensitive to the Transient Mark mode."
   :version "21.1"
   :group 'editing-basics)
 
-(defun next-line (&optional arg)
+(defun next-line (&optional arg try-vscroll)
   "Move cursor vertically down ARG lines.
+Interactively, vscroll tall lines if `auto-window-vscroll' is enabled.
 If there is no character in the target line exactly under the current column,
 the cursor is positioned after the character in that line which spans this
 column, or at the end of the line if it is not long enough.
@@ -3103,7 +3198,7 @@ when there is no goal column.
 If you are thinking of using this in a Lisp program, consider
 using `forward-line' instead.  It is usually easier to use
 and more reliable (no dependence on goal column, etc.)."
-  (interactive "p")
+  (interactive "p\np")
   (or arg (setq arg 1))
   (if (and next-line-add-newlines (= arg 1))
       (if (save-excursion (end-of-line) (eobp))
@@ -3111,16 +3206,17 @@ and more reliable (no dependence on goal column, etc.)."
          (let ((abbrev-mode nil))
            (end-of-line)
            (insert "\n"))
-       (line-move arg))
+       (line-move arg nil nil try-vscroll))
     (if (interactive-p)
        (condition-case nil
-           (line-move arg)
+           (line-move arg nil nil try-vscroll)
          ((beginning-of-buffer end-of-buffer) (ding)))
-      (line-move arg)))
+      (line-move arg nil nil try-vscroll)))
   nil)
 
-(defun previous-line (&optional arg)
+(defun previous-line (&optional arg try-vscroll)
   "Move cursor vertically up ARG lines.
+Interactively, vscroll tall lines if `auto-window-vscroll' is enabled.
 If there is no character in the target line exactly over the current column,
 the cursor is positioned after the character in that line which spans this
 column, or at the end of the line if it is not long enough.
@@ -3135,13 +3231,13 @@ when there is no goal column.
 If you are thinking of using this in a Lisp program, consider using
 `forward-line' with a negative argument instead.  It is usually easier
 to use and more reliable (no dependence on goal column, etc.)."
-  (interactive "p")
+  (interactive "p\np")
   (or arg (setq arg 1))
   (if (interactive-p)
       (condition-case nil
-         (line-move (- arg))
+         (line-move (- arg) nil nil try-vscroll)
        ((beginning-of-buffer end-of-buffer) (ding)))
-    (line-move (- arg)))
+    (line-move (- arg) nil nil try-vscroll))
   nil)
 
 (defcustom track-eol nil
@@ -3179,10 +3275,41 @@ Outline mode sets this."
       (or (memq prop buffer-invisibility-spec)
          (assq prop buffer-invisibility-spec)))))
 
+;; Perform vertical scrolling of tall images if necessary.
+;; Don't vscroll in a keyboard macro.
+(defun line-move (arg &optional noerror to-end try-vscroll)
+  (if (and auto-window-vscroll try-vscroll
+          (not defining-kbd-macro)
+          (not executing-kbd-macro))
+      (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)
+         (when (line-move-1 arg noerror to-end)
+           (sit-for 0)
+           (if (and (not forward)
+                    (setq part (nth 2 (pos-visible-in-window-p
+                                       (line-beginning-position) nil t)))
+                    (> (cdr part) 0))
+               (set-window-vscroll nil (cdr part) t))
+           t)))
+    (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)
@@ -3395,6 +3522,25 @@ boundaries bind `inhibit-field-text-motion' to t."
              (setq arg 1)
            (setq done t)))))))
 
+(defun move-beginning-of-line (arg)
+  "Move point to beginning of current display line.
+With argument ARG not nil or 1, move forward ARG - 1 lines first.
+If point reaches the beginning or end of buffer, it stops there.
+To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
+
+This command does not move point across a field boundary unless doing so
+would move beyond there to a different line; if ARG is nil or 1, and
+point starts at a field boundary, point does not move.  To ignore field
+boundaries bind `inhibit-field-text-motion' to t."
+  (interactive "p")
+  (or arg (setq arg 1))
+  (if (/= arg 1)
+      (line-move (1- arg) t))
+  (let ((orig (point)))
+    (vertical-motion 0)
+    (goto-char (constrain-to-field (point) orig (/= arg 1) t nil))))
+
+
 ;;; Many people have said they rarely use this feature, and often type
 ;;; it by accident.  Maybe it shouldn't even be on a key.
 (put 'set-goal-column 'disabled t)
@@ -4001,7 +4147,7 @@ when it is off screen)."
                (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)
@@ -4606,7 +4752,8 @@ of the differing parts is, by contrast, slightly highlighted."
                               (point-min)
                               'mouse-face))
               (element-common-end
-               (+ (or element-start nil) common-string-length))
+               (and element-start
+                    (+ (or element-start nil) common-string-length)))
               (maxp (point-max)))
          (while (and element-start (< element-common-end maxp))
            (when (and (get-char-property element-start 'mouse-face)
@@ -4911,7 +5058,18 @@ the front of the list of recently selected ones."
 \f
 ;;; Handling of Backspace and Delete keys.
 
-(defcustom normal-erase-is-backspace nil
+(defcustom normal-erase-is-backspace
+  (and (not noninteractive)
+       (or (memq system-type '(ms-dos windows-nt))
+          (eq window-system 'mac)
+          (and (memq window-system '(x))
+               (fboundp 'x-backspace-delete-keys-p)
+               (x-backspace-delete-keys-p))
+          ;; If the terminal Emacs is running on has erase char
+          ;; set to ^H, use the Backspace key for deleting
+          ;; backward and, and the Delete key for deleting forward.
+          (and (null window-system)
+               (eq tty-erase-char ?\^H))))
   "If non-nil, Delete key deletes forward and Backspace key deletes backward.
 
 On window systems, the default value of this option is chosen
@@ -5026,7 +5184,7 @@ 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 "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.")