(compose-string, encode-composition-rule, compose-last-chars):

[gnu-emacs] / lisp / simple.el

diff --git a/lisp/simple.el b/lisp/simple.el
index 3c9ea979fedba7f599736441e0ca9fb085dfceb8..e0622aed690d91ebff3847bf8ae4a57d27573e00 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -21,8 +21,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
 
 ;; You should have received a copy of the GNU General Public License
 ;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -110,6 +110,11 @@ If `fringe-arrow', indicate the locus by the fringe arrow."
   :group 'next-error
   :version "22.1")
 
   :group 'next-error
   :version "22.1")
 

+(defcustom next-error-hook nil
+  "*List of hook functions run by `next-error' after visiting source file."
+  :type 'hook
+  :group 'next-error)
+

 (defvar next-error-highlight-timer nil)
 
 (defvar next-error-overlay-arrow-position nil)
 (defvar next-error-highlight-timer nil)
 
 (defvar next-error-overlay-arrow-position nil)


@@ -148,7 +153,7 @@ 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
 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 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))))
 that buffer is rejected."
   (and (buffer-name buffer)            ;First make sure it's live.
        (not (and avoid-current (eq buffer (current-buffer))))


@@ -169,7 +174,7 @@ that buffer is rejected."
 If AVOID-CURRENT is non-nil, treat the current buffer
 as an absolute last resort only.
 
 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
+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.
 
 that normally would not qualify.  If it returns t, the buffer
 in question is treated as usable.
 


@@ -240,9 +245,10 @@ 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.
 
 \\[next-error] in that buffer when it is the only one displayed
 in the current frame.
 

-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.
+Once \\[next-error] has chosen the buffer for error messages, it
+runs `next-error-hook' with `run-hooks', and stays with that buffer
+until you use it in some other buffer which uses Compilation mode
+or Compilation Minor mode.

 
 See variables `compilation-parse-errors-function' and
 \`compilation-error-regexp-alist' for customization ideas."
 
 See variables `compilation-parse-errors-function' and
 \`compilation-error-regexp-alist' for customization ideas."


@@ -251,7 +257,8 @@ See variables `compilation-parse-errors-function' and
   (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
   (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

-      (funcall next-error-function (prefix-numeric-value arg) reset))))
+      (funcall next-error-function (prefix-numeric-value arg) reset)
+      (run-hooks 'next-error-hook))))

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


@@ -327,7 +334,8 @@ location."
 Other major modes are defined by comparison with this one."
   (interactive)
   (kill-all-local-variables)
 Other major modes are defined by comparison with this one."
   (interactive)
   (kill-all-local-variables)

-  (run-hooks 'after-change-major-mode-hook))
+  (unless delay-mode-hooks
+    (run-hooks 'after-change-major-mode-hook)))

 
 ;; Making and deleting lines.
 
 
 ;; Making and deleting lines.
 


@@ -920,21 +928,21 @@ in *Help* buffer.  See also the command `describe-char'."
 (defvar read-expression-history nil)
 
 (defcustom eval-expression-print-level 4
 (defvar read-expression-history nil)
 
 (defcustom eval-expression-print-level 4

-  "*Value to use for `print-level' when printing value in `eval-expression'.
+  "Value for `print-level' while printing value in `eval-expression'.

 A value of nil means no limit."
   :group 'lisp
   :type '(choice (const :tag "No Limit" nil) integer)
   :version "21.1")
 
 (defcustom eval-expression-print-length 12
 A value of nil means no limit."
   :group 'lisp
   :type '(choice (const :tag "No Limit" nil) integer)
   :version "21.1")
 
 (defcustom eval-expression-print-length 12

-  "*Value to use for `print-length' when printing value in `eval-expression'.
+  "Value for `print-length' while printing value in `eval-expression'.

 A value of nil means no limit."
   :group 'lisp
   :type '(choice (const :tag "No Limit" nil) integer)
   :version "21.1")
 
 (defcustom eval-expression-debug-on-error t
 A value of nil means no limit."
   :group 'lisp
   :type '(choice (const :tag "No Limit" nil) integer)
   :version "21.1")
 
 (defcustom eval-expression-debug-on-error t

-  "*Non-nil means set `debug-on-error' when evaluating in `eval-expression'.
+  "If non-nil set `debug-on-error' to t in `eval-expression'.

 If nil, don't change the value of `debug-on-error'."
   :group 'lisp
   :type 'boolean
 If nil, don't change the value of `debug-on-error'."
   :group 'lisp
   :type 'boolean


@@ -1287,7 +1295,7 @@ A redo record for ordinary undo maps to the following (earlier) undo.")
 
 (defvar pending-undo-list nil
   "Within a run of consecutive undo commands, list remaining to be undone.
 
 (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.")
+If t, we undid all the way to the end of it.")

 
 (defun undo (&optional arg)
   "Undo some previous changes.
 
 (defun undo (&optional arg)
   "Undo some previous changes.


@@ -1399,16 +1407,16 @@ Contrary to `undo', this will not redo a previous undo."
   "Non-nil while performing an undo.
 Some change-hooks test this variable to do something different.")
 
   "Non-nil while performing an undo.
 Some change-hooks test this variable to do something different.")
 

-(defun undo-more (count)
+(defun undo-more (n)

   "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 (listp pending-undo-list)
   "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 (listp pending-undo-list)

-      (error (format "No further undo information%s"
-                    (if (and transient-mark-mode mark-active)
-                        " for region" ""))))
+      (error (concat "No further undo information"
+                     (and transient-mark-mode mark-active
+                          " for region"))))

   (let ((undo-in-progress t))
   (let ((undo-in-progress t))

-    (setq pending-undo-list (primitive-undo count pending-undo-list))
+    (setq pending-undo-list (primitive-undo n pending-undo-list))

     (if (null pending-undo-list)
        (setq pending-undo-list t))))
 
     (if (null pending-undo-list)
        (setq pending-undo-list t))))
 


@@ -2247,7 +2255,7 @@ is nil, the buffer substring is returned unaltered.
 If DELETE is non-nil, the text between BEG and END is deleted
 from the buffer.
 
 If DELETE is non-nil, the text between BEG and END is deleted
 from the buffer.
 

-Point is temporarily set to BEG before caling
+Point is temporarily set to BEG before calling

 `buffer-substring-filters', in case the functions need to know
 where the text came from.
 
 `buffer-substring-filters', in case the functions need to know
 where the text came from.
 


@@ -2763,7 +2771,7 @@ even beep.)"
   "Kill current line.
 With prefix arg, kill that many lines starting from the current line.
 If arg is negative, kill backward.  Also kill the preceding newline.
   "Kill current line.
 With prefix arg, kill that many lines starting from the current line.
 If arg is negative, kill backward.  Also kill the preceding newline.

-\(This is meant to make C-x z work well with negative arguments.\)
+\(This is meant to make \\[repeat] work well with negative arguments.\)

 If arg is zero, kill current line but exclude the trailing newline."
   (interactive "p")
   (if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp)))
 If arg is zero, kill current line but exclude the trailing newline."
   (interactive "p")
   (if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp)))


@@ -3342,34 +3350,43 @@ Outline mode sets this."
       (or (memq prop buffer-invisibility-spec)
          (assq prop buffer-invisibility-spec)))))
 
       (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.
+;; This is like line-move-1 except that it also performs
+;; vertical scrolling of tall images if appropriate.
+;; That is not really a clean thing to do, since it mixes
+;; scrolling with cursor motion.  But so far we don't have
+;; a cleaner solution to the problem of making C-n do something
+;; useful given a tall image.

 (defun line-move (arg &optional noerror to-end try-vscroll)
   (if (and auto-window-vscroll try-vscroll
 (defun line-move (arg &optional noerror to-end try-vscroll)
   (if (and auto-window-vscroll try-vscroll

+          ;; But don't vscroll in a keyboard macro.

           (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)
           (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))
+                (> (if forward (cdr part) (car part)) 0))

            (set-window-vscroll nil
                                (if forward
                                    (+ (window-vscroll nil t)
            (set-window-vscroll nil
                                (if forward
                                    (+ (window-vscroll nil t)

-                                      (min part
+                                      (min (cdr part)

                                            (* (frame-char-height) arg)))
                                  (max 0
                                       (- (window-vscroll nil t)
                                            (* (frame-char-height) arg)))
                                  (max 0
                                       (- (window-vscroll nil t)

-                                         (min part
+                                         (min (car part)

                                               (* (frame-char-height) (- arg))))))
                                t)
          (set-window-vscroll nil 0)
          (when (line-move-1 arg noerror to-end)
                                               (* (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))
+           (when (not forward)
+             ;; Update display before calling pos-visible-in-window-p,
+             ;; because it depends on window-start being up-to-date.
+             (sit-for 0)
+             ;; If the current line is partly hidden at the bottom,
+             ;; scroll it partially up so as to unhide the bottom.
+             (if (and (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)))
 
            t)))
     (line-move-1 arg noerror to-end)))
 


@@ -3423,39 +3440,41 @@ Outline mode sets this."
                ;; Now move a line.
                (end-of-line)
                ;; If there's no invisibility here, move over the newline.
                ;; Now move a line.
                (end-of-line)
                ;; If there's no invisibility here, move over the newline.

-               (if (and (not (integerp selective-display))
-                        (not (line-move-invisible-p (point))))
-                   ;; We avoid vertical-motion when possible
-                   ;; because that has to fontify.
-                   (if (eobp)
-                       (if (not noerror)
-                           (signal 'end-of-buffer nil)
-                         (setq done t))
-                     (forward-line 1))
-                 ;; Otherwise move a more sophisticated way.
-                 ;; (What's the logic behind this code?)
-                 (and (zerop (vertical-motion 1))
-                      (if (not noerror)
-                          (signal 'end-of-buffer nil)
-                        (setq done t))))
+               (cond
+                ((eobp)
+                 (if (not noerror)
+                     (signal 'end-of-buffer nil)
+                   (setq done t)))
+                ((and (> arg 1)  ;; Use vertical-motion for last move
+                      (not (integerp selective-display))
+                      (not (line-move-invisible-p (point))))
+                 ;; We avoid vertical-motion when possible
+                 ;; because that has to fontify.
+                 (forward-line 1))
+                ;; Otherwise move a more sophisticated way.
+                ((zerop (vertical-motion 1))
+                 (if (not noerror)
+                     (signal 'end-of-buffer nil)
+                   (setq done t))))

                (unless done
                  (setq arg (1- arg))))
              ;; The logic of this is the same as the loop above,
              ;; it just goes in the other direction.
              (while (and (< arg 0) (not done))
                (beginning-of-line)
                (unless done
                  (setq arg (1- arg))))
              ;; The logic of this is the same as the loop above,
              ;; it just goes in the other direction.
              (while (and (< arg 0) (not done))
                (beginning-of-line)

-               (if (or (bobp)
-                       (and (not (integerp selective-display))
-                            (not (line-move-invisible-p (1- (point))))))
-                   (if (bobp)
-                       (if (not noerror)
-                           (signal 'beginning-of-buffer nil)
-                         (setq done t))
-                     (forward-line -1))
-                 (if (zerop (vertical-motion -1))
-                     (if (not noerror)
-                         (signal 'beginning-of-buffer nil)
-                       (setq done t))))
+               (cond
+                ((bobp)
+                 (if (not noerror)
+                     (signal 'beginning-of-buffer nil)
+                   (setq done t)))
+                ((and (< arg -1) ;; Use vertical-motion for last move
+                      (not (integerp selective-display))
+                      (not (line-move-invisible-p (1- (point)))))
+                 (forward-line -1))
+                ((zerop (vertical-motion -1))
+                 (if (not noerror)
+                     (signal 'beginning-of-buffer nil)
+                   (setq done t))))

                (unless done
                  (setq arg (1+ arg))
                  (while (and ;; Don't move over previous invis lines
                (unless done
                  (setq arg (1+ arg))
                  (while (and ;; Don't move over previous invis lines


@@ -3915,9 +3934,7 @@ If optional arg REALLY-WORD is non-nil, it finds just a word."
 
 This function is only called during auto-filling of a comment section.
 The function should take a single optional argument, which is a flag
 
 This function is only called during auto-filling of a comment section.
 The function should take a single optional argument, which is a flag

-indicating whether it should use soft newlines.
-
-Setting this variable automatically makes it local to the current buffer.")
+indicating whether it should use soft newlines.")

 
 ;; This function is used as the auto-fill-function of a buffer
 ;; when Auto-Fill mode is enabled.
 
 ;; This function is used as the auto-fill-function of a buffer
 ;; when Auto-Fill mode is enabled.


@@ -4496,10 +4513,11 @@ Each action has the form (FUNCTION . ARGS)."
 (defvar set-variable-value-history nil
   "History of values entered with `set-variable'.")
 
 (defvar set-variable-value-history nil
   "History of values entered with `set-variable'.")
 

-(defun set-variable (var val &optional make-local)
+(defun set-variable (variable value &optional make-local)

   "Set VARIABLE to VALUE.  VALUE is a Lisp object.
   "Set VARIABLE to VALUE.  VALUE is a Lisp object.

-When using this interactively, enter a Lisp object for VALUE.
-If you want VALUE to be a string, you must surround it with doublequotes.
+VARIABLE should be a user option variable name, a Lisp variable
+meant to be customized by users.  You should enter VALUE in Lisp syntax,
+so if you want VALUE to be a string, you must surround it with doublequotes.

 VALUE is used literally, not evaluated.
 
 If VARIABLE has a `variable-interactive' property, that is used as if
 VALUE is used literally, not evaluated.
 
 If VARIABLE has a `variable-interactive' property, that is used as if


@@ -4512,45 +4530,52 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally."
   (interactive
    (let* ((default-var (variable-at-point))
           (var (if (symbolp default-var)
   (interactive
    (let* ((default-var (variable-at-point))
           (var (if (symbolp default-var)

-                   (read-variable (format "Set variable (default %s): " default-var)
-                                  default-var)
-                 (read-variable "Set variable: ")))
+                       (read-variable (format "Set variable (default %s): " default-var)
+                                      default-var)
+                     (read-variable "Set variable: ")))

          (minibuffer-help-form '(describe-variable var))
          (prop (get var 'variable-interactive))
          (minibuffer-help-form '(describe-variable var))
          (prop (get var 'variable-interactive))

-         (prompt (format "Set %s%s to value: " var
+          (obsolete (car (get var 'byte-obsolete-variable)))
+         (prompt (format "Set %s %s to value: " var

                          (cond ((local-variable-p var)
                          (cond ((local-variable-p var)

-                                " (buffer-local)")
+                                "(buffer-local)")

                                ((or current-prefix-arg
                                     (local-variable-if-set-p var))
                                ((or current-prefix-arg
                                     (local-variable-if-set-p var))

-                                " buffer-locally")
-                               (t " globally"))))
-         (val (if prop
-                  ;; Use VAR's `variable-interactive' property
-                  ;; as an interactive spec for prompting.
-                  (call-interactively `(lambda (arg)
-                                         (interactive ,prop)
-                                         arg))
-                (read
-                 (read-string prompt nil
-                              'set-variable-value-history)))))
+                                "buffer-locally")
+                               (t "globally"))))
+         (val (progn
+                 (when obsolete
+                   (message (concat "`%S' is obsolete; "
+                                    (if (symbolp obsolete) "use `%S' instead" "%s"))
+                            var obsolete)
+                   (sit-for 3))
+                 (if prop
+                     ;; Use VAR's `variable-interactive' property
+                     ;; as an interactive spec for prompting.
+                     (call-interactively `(lambda (arg)
+                                            (interactive ,prop)
+                                            arg))
+                   (read
+                    (read-string prompt nil
+                                 'set-variable-value-history))))))

      (list var val current-prefix-arg)))
 
      (list var val current-prefix-arg)))
 

-  (and (custom-variable-p var)
-       (not (get var 'custom-type))
-       (custom-load-symbol var))
-  (let ((type (get var 'custom-type)))
+  (and (custom-variable-p variable)
+       (not (get variable 'custom-type))
+       (custom-load-symbol variable))
+  (let ((type (get variable 'custom-type)))

     (when type
       ;; Match with custom type.
       (require 'cus-edit)
       (setq type (widget-convert type))
     (when type
       ;; Match with custom type.
       (require 'cus-edit)
       (setq type (widget-convert type))

-      (unless (widget-apply type :match val)
+      (unless (widget-apply type :match value)

        (error "Value `%S' does not match type %S of %S"
        (error "Value `%S' does not match type %S of %S"

-              val (car type) var))))
+              value (car type) variable))))

 
   (if make-local
 
   (if make-local

-      (make-local-variable var))
+      (make-local-variable variable))

 
 

-  (set var val)
+  (set variable value)

 
   ;; Force a thorough redisplay for the case that the variable
   ;; has an effect on the display, like `tab-width' has.
 
   ;; Force a thorough redisplay for the case that the variable
   ;; has an effect on the display, like `tab-width' has.


@@ -4762,7 +4787,7 @@ Use \\<completion-list-mode-map>\\[mouse-choose-completion] to select one\
   (setq major-mode 'completion-list-mode)
   (make-local-variable 'completion-base-size)
   (setq completion-base-size nil)
   (setq major-mode 'completion-list-mode)
   (make-local-variable 'completion-base-size)
   (setq completion-base-size nil)

-  (run-hooks 'completion-list-mode-hook))
+  (run-mode-hooks 'completion-list-mode-hook))

 
 (defun completion-list-mode-finish ()
   "Finish setup of the completions buffer.
 
 (defun completion-list-mode-finish ()
   "Finish setup of the completions buffer.


@@ -4831,7 +4856,11 @@ of the differing parts is, by contrast, slightly highlighted."
                    (- (point) (minibuffer-prompt-end)))))
        ;; Otherwise, in minibuffer, the whole input is being completed.
        (if (minibufferp mainbuf)
                    (- (point) (minibuffer-prompt-end)))))
        ;; Otherwise, in minibuffer, the whole input is being completed.
        (if (minibufferp mainbuf)

-           (setq completion-base-size 0)))
+           (if (and (symbolp minibuffer-completion-table)
+                    (get minibuffer-completion-table 'completion-base-size-function))
+               (setq completion-base-size
+                     (funcall (get minibuffer-completion-table 'completion-base-size-function)))
+             (setq completion-base-size 0))))

       ;; Put faces on first uncommon characters and common parts.
       (when completion-base-size
        (let* ((common-string-length
       ;; Put faces on first uncommon characters and common parts.
       (when completion-base-size
        (let* ((common-string-length


@@ -5102,7 +5131,7 @@ after it has been set up properly in other respects."
 (defun clone-indirect-buffer (newname display-flag &optional norecord)
   "Create an indirect buffer that is a twin copy of the current buffer.
 
 (defun clone-indirect-buffer (newname display-flag &optional norecord)
   "Create an indirect buffer that is a twin copy of the current buffer.
 

-Give the indirect buffer name NEWNAME.  Interactively, read NEW-NAME
+Give the indirect buffer name NEWNAME.  Interactively, read NEWNAME

 from the minibuffer when invoked with a prefix arg.  If NEWNAME is nil
 or if not called with a prefix arg, NEWNAME defaults to the current
 buffer's name.  The name is modified by adding a `<N>' suffix to it
 from the minibuffer when invoked with a prefix arg.  If NEWNAME is nil
 or if not called with a prefix arg, NEWNAME defaults to the current
 buffer's name.  The name is modified by adding a `<N>' suffix to it