Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-95
[bpt/emacs.git] / lisp / simple.el
index f06a279..682880e 100644 (file)
@@ -261,6 +261,14 @@ See variables `compilation-parse-errors-function' and
       (funcall next-error-function (prefix-numeric-value arg) reset)
       (run-hooks 'next-error-hook))))
 
+(defun next-error-internal ()
+  "Visit the source code corresponding to the `next-error' message at point."
+  (setq next-error-last-buffer (current-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 0 nil)
+    (run-hooks 'next-error-hook)))
+
 (defalias 'goto-next-locus 'next-error)
 (defalias 'next-match 'next-error)
 
@@ -888,22 +896,42 @@ in *Help* buffer.  See also the command `describe-char'."
          (message "point=%d of %d (%d%%) column %d %s"
                   pos total percent col hscroll))
       (let ((coding buffer-file-coding-system)
-           encoded encoding-msg)
+           encoded encoding-msg display-prop under-display)
        (if (or (not coding)
                (eq (coding-system-type coding) t))
            (setq coding default-buffer-file-coding-system))
-       (if (not (char-valid-p char))
+       (if (eq (char-charset char) 'eight-bit)
            (setq encoding-msg
-                 (format "(0%o, %d, 0x%x, invalid)" char char char))
-         (setq encoded (and (>= char 128) (encode-coding-char char coding)))
+                 (format "(0%o, %d, 0x%x, raw-byte)" char char char))
+         ;; Check if the character is displayed with some `display'
+         ;; text property.  In that case, set under-display to the
+         ;; buffer substring covered by that property.
+         (setq display-prop (get-text-property pos 'display))
+         (if display-prop
+             (let ((to (or (next-single-property-change pos 'display)
+                           (point-max))))
+               (if (< to (+ pos 4))
+                   (setq under-display "")
+                 (setq under-display "..."
+                       to (+ pos 4)))
+               (setq under-display
+                     (concat (buffer-substring-no-properties pos to)
+                             under-display)))
+           (setq encoded (and (>= char 128) (encode-coding-char char coding))))
          (setq encoding-msg
-               (if encoded
-                   (format "(0%o, %d, 0x%x, file %s)"
-                           char char char
-                           (if (> (length encoded) 1)
-                               "..."
-                             (encoded-string-description encoded coding)))
-                 (format "(0%o, %d, 0x%x)" char char char))))
+               (if display-prop
+                   (if (not (stringp display-prop))
+                       (format "(0%o, %d, 0x%x, part of display \"%s\")"
+                               char char char under-display)
+                     (format "(0%o, %d, 0x%x, part of display \"%s\"->\"%s\")"
+                             char char char under-display display-prop))
+                 (if encoded
+                     (format "(0%o, %d, 0x%x, file %s)"
+                             char char char
+                             (if (> (length encoded) 1)
+                                 "..."
+                               (encoded-string-description encoded coding)))
+                   (format "(0%o, %d, 0x%x)" char char char)))))
        (if detail
            ;; We show the detailed information about CHAR.
            (describe-char (point)))
@@ -914,9 +942,11 @@ in *Help* buffer.  See also the command `describe-char'."
                       (buffer-substring-no-properties (point) (1+ (point))))
                     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))))
+                  (if enable-multibyte-characters
+                      (if (< char 128)
+                          (single-key-description char)
+                        (buffer-substring-no-properties (point) (1+ (point))))
+                    (single-key-description char))
                   encoding-msg pos total percent col hscroll))))))
 \f
 (defvar read-expression-map
@@ -4236,7 +4266,7 @@ If nil, search stops at the beginning of the accessible portion of the buffer."
 (defun blink-matching-open ()
   "Move cursor momentarily to the beginning of the sexp before point."
   (interactive)
-  (when (and (> (point) (1+ (point-min)))
+  (when (and (> (point) (point-min))
             blink-matching-paren
             ;; Verify an even number of quoting characters precede the close.
             (= 1 (logand 1 (- (point)
@@ -4542,10 +4572,10 @@ in the definition is used to check that VALUE is valid.
 With a prefix argument, set VARIABLE to VALUE buffer-locally."
   (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: ")))
+          (var (if (user-variable-p default-var)
+                  (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))
           (obsolete (car (get var 'byte-obsolete-variable)))
@@ -4570,7 +4600,8 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally."
                                             arg))
                    (read
                     (read-string prompt nil
-                                 'set-variable-value-history))))))
+                                 'set-variable-value-history
+                                (format "%S" (symbol-value var))))))))
      (list var val current-prefix-arg)))
 
   (and (custom-variable-p variable)
@@ -4814,10 +4845,13 @@ Called from `temp-buffer-show-hook'."
   "Normal hook run at the end of setting up a completion list buffer.
 When this hook is run, the current buffer is the one in which the
 command to display the completion list buffer was run.
-The completion list buffer is available as the value of `standard-output'.")
+The completion list buffer is available as the value of `standard-output'.
+The common prefix substring for completion may be available as the 
+value of `completion-common-substring'. See also `display-completion-list'.")
+
+
+;; Variables and faces used in `completion-setup-function'.
 
-;; This function goes in completion-setup-hook, so that it is called
-;; after the text of the completion list buffer is written.
 (defface completions-first-difference
   '((t (:inherit bold)))
   "Face put on the first uncommon character in completions in *Completions* buffer."
@@ -4837,6 +4871,17 @@ of the differing parts is, by contrast, slightly highlighted."
 (defvar completion-root-regexp "^/"
   "Regexp to use in `completion-setup-function' to find the root directory.")
 
+(defvar completion-common-substring nil
+  "Common prefix substring to use in `completion-setup-function' to put faces.
+The value is set by `display-completion-list' during running `completion-setup-hook'.
+
+To put faces, `completions-first-difference' and `completions-common-part' 
+into \"*Completions*\* buffer, the common prefix substring in completions is
+needed as a hint. (Minibuffer is a special case. The content of minibuffer itself 
+is the substring.)")
+
+;; This function goes in completion-setup-hook, so that it is called
+;; after the text of the completion list buffer is written.
 (defun completion-setup-function ()
   (let ((mainbuf (current-buffer))
        (mbuf-contents (minibuffer-contents)))
@@ -4875,9 +4920,11 @@ of the differing parts is, by contrast, slightly highlighted."
                      (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
+      (when (or completion-base-size completion-common-substring)
        (let* ((common-string-length
-               (- (length mbuf-contents) completion-base-size))
+               (if completion-base-size
+                   (- (length mbuf-contents) completion-base-size)
+                 (length completion-common-substring)))
               (element-start (next-single-property-change
                               (point-min)
                               'mouse-face))