]> code.delx.au - gnu-emacs/blobdiff - lisp/simple.el
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-29
[gnu-emacs] / lisp / simple.el
index f76c66627254c25ab6b6c96b0291ae89fe06ee6e..8039ed26b392931d5d9dffcb40bc4cfbeab615f3 100644 (file)
@@ -37,7 +37,7 @@
 
 
 (defgroup killing nil
-  "Killing and yanking commands"
+  "Killing and yanking commands."
   :group 'editing)
 
 (defgroup paren-matching nil
@@ -91,36 +91,49 @@ to navigate in it.")
     (or (and extra-test (funcall extra-test))
        next-error-function)))
 
-;; Return a next-error capable buffer.
-;; If the current buffer is such, return it.
-;; If next-error-last-buffer is set to a live buffer, use that.
-;; Otherwise, look for a next-error capable buffer and signal an error
-;; if there are none.
+;; Return a next-error capable buffer according to the following rules:
+;; 1. If the current buffer is a next-error capable buffer, return it.
+;; 2. If one window on the selected frame displays such buffer, return it.
+;; 3. If next-error-last-buffer is set to a live buffer, use that.
+;; 4. Otherwise, look for a next-error capable buffer in a buffer list.
+;; 5. Signal an error if there are none.
 (defun next-error-find-buffer (&optional other-buffer extra-test)
   (if (and (not other-buffer)
           (next-error-buffer-p (current-buffer) extra-test))
       ;; The current buffer is a next-error capable buffer.
       (current-buffer)
-    (if (and next-error-last-buffer (buffer-name next-error-last-buffer)
-            (next-error-buffer-p next-error-last-buffer extra-test)
-            (or (not other-buffer) (not (eq next-error-last-buffer
-                                            (current-buffer)))))
-       next-error-last-buffer
-      (let ((buffers (buffer-list)))
-       (while (and buffers (or (not (next-error-buffer-p (car buffers) extra-test))
-                               (and other-buffer
-                                    (eq (car buffers) (current-buffer)))))
-         (setq buffers (cdr buffers)))
-       (if buffers
-           (car buffers)
-         (or (and other-buffer
-                  (next-error-buffer-p (current-buffer) extra-test)
-                  ;; 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!")))))))
+    (or
+     (let ((window-buffers
+            (delete-dups
+             (delq nil
+              (mapcar (lambda (w)
+                        (and (next-error-buffer-p (window-buffer w) extra-test)
+                             (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)))
+     (if (and next-error-last-buffer (buffer-name next-error-last-buffer)
+              (next-error-buffer-p next-error-last-buffer extra-test)
+              (or (not other-buffer) (not (eq next-error-last-buffer
+                                              (current-buffer)))))
+         next-error-last-buffer
+       (let ((buffers (buffer-list)))
+         (while (and buffers (or (not (next-error-buffer-p (car buffers) extra-test))
+                                 (and other-buffer
+                                      (eq (car buffers) (current-buffer)))))
+           (setq buffers (cdr buffers)))
+         (if buffers
+             (car buffers)
+           (or (and other-buffer
+                    (next-error-buffer-p (current-buffer) extra-test)
+                    ;; 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"))))))))
 
 (defun next-error (arg &optional reset)
   "Visit next next-error message and corresponding source code.
@@ -549,9 +562,13 @@ If BACKWARD-ONLY is non-nil, only delete spaces before point."
        (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 arg N, put point N/10 of the way from the beginning.
+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.
 
 If the buffer is narrowed, this command uses the beginning and size
 of the accessible part of the buffer.
@@ -559,9 +576,10 @@ of the accessible part of the buffer.
 Don't use this command in Lisp programs!
 \(goto-char (point-min)) is faster and avoids clobbering the mark."
   (interactive "P")
-  (push-mark)
+  (unless (or inhibit-mark-movement (consp arg))
+    (push-mark))
   (let ((size (- (point-max) (point-min))))
-    (goto-char (if arg
+    (goto-char (if (and arg (not (consp arg)))
                   (+ (point-min)
                      (if (> size 10000)
                          ;; Avoid overflow for large buffer sizes!
@@ -573,7 +591,8 @@ Don't use this command in Lisp programs!
 
 (defun end-of-buffer (&optional arg)
   "Move point to the end of the buffer; leave mark at previous position.
-With arg N, put point N/10 of the way from the end.
+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.
 
 If the buffer is narrowed, this command uses the beginning and size
 of the accessible part of the buffer.
@@ -581,9 +600,10 @@ of the accessible part of the buffer.
 Don't use this command in Lisp programs!
 \(goto-char (point-max)) is faster and avoids clobbering the mark."
   (interactive "P")
-  (push-mark)
+  (unless (or inhibit-mark-movement (consp arg))
+    (push-mark))
   (let ((size (- (point-max) (point-min))))
-    (goto-char (if arg
+    (goto-char (if (and arg (not (consp arg)))
                   (- (point-max)
                      (if (> size 10000)
                          ;; Avoid overflow for large buffer sizes!
@@ -715,9 +735,9 @@ in *Help* buffer.  See also the command `describe-char'."
        (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))
+                 (format "(0%o, %d, 0x%x, raw-byte)" char char char))
          (setq encoded (and (>= char 128) (encode-coding-char char coding)))
          (setq encoding-msg
                (if encoded
@@ -772,6 +792,23 @@ If nil, don't change the value of `debug-on-error'."
   :type 'boolean
   :version "21.1")
 
+(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)
+           (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
+               (eq this-command last-command)
+               (and (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)))
+                 (prin1-char value))))
+        (if char-string
+            (format " (0%o, 0x%x) = %s" value value char-string)
+          (format " (0%o, 0x%x)" value value)))))
+
 ;; We define this, rather than making `eval' interactive,
 ;; for the sake of completion of names like eval-region, eval-current-buffer.
 (defun eval-expression (eval-expression-arg
@@ -806,7 +843,10 @@ the echo area."
        (with-no-warnings
         (let ((standard-output (current-buffer)))
           (eval-last-sexp-print-value (car values))))
-      (prin1 (car values) t))))
+      (prog1
+          (prin1 (car values) t)
+        (let ((str (eval-expression-print-format (car values))))
+          (if str (princ str t)))))))
 
 (defun edit-and-eval-command (prompt command)
   "Prompting with PROMPT, let user edit COMMAND and eval result.
@@ -920,7 +960,8 @@ See also `minibuffer-history-case-insensitive-variables'."
                                        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 "")
               (if minibuffer-history-search-history
@@ -2070,7 +2111,7 @@ the text, but put the text in the kill ring anyway.  This means that
 you can use the killing commands to copy text from a read-only buffer.
 
 This is the primitive for programs to kill text (as opposed to deleting it).
-Supply two arguments, character numbers indicating the stretch of text
+Supply two arguments, character positions indicating the stretch of text
  to be killed.
 Any command that calls this function is a \"kill command\".
 If the previous command was also a kill command,
@@ -2187,7 +2228,7 @@ The argument is used for internal purposes; do not supply one."
 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 'editing
+  :group 'killing
   :version "21.4")
 
 (defvar yank-window-start nil)
@@ -3330,7 +3371,8 @@ With argument, do this that many times."
   "Return the symbol or word that point is on (or a nearby one) as a string.
 The return value includes no text properties.
 If optional arg STRICT is non-nil, return nil unless point is within
-or adjacent to a symbol or word.
+or adjacent to a symbol or word.  In all cases the value can be nil
+if there is no word nearby.
 The function, belying its name, normally finds a symbol.
 If optional arg REALLY-WORD is non-nil, it finds just a word."
   (save-excursion
@@ -4262,6 +4304,12 @@ make the common parts less visible than normal, so that the rest
 of the differing parts is, by contrast, slightly highlighted."
   :group 'completion)
 
+;; This is for packages that need to bind it to a non-default regexp
+;; in order to make the first-differing character highlight work
+;; to their liking
+(defvar completion-root-regexp "^/"
+  "Regexp to use in `completion-setup-function' to find the root directory.")
+
 (defun completion-setup-function ()
   (let ((mainbuf (current-buffer))
        (mbuf-contents (minibuffer-contents)))
@@ -4271,6 +4319,13 @@ of the differing parts is, by contrast, slightly highlighted."
     (if minibuffer-completing-file-name
        (with-current-buffer mainbuf
          (setq default-directory (file-name-directory mbuf-contents))))
+    ;; If partial-completion-mode is on, point might not be after the
+    ;; last character in the minibuffer.
+    ;; FIXME: This still doesn't work if the text to be completed
+    ;; starts with a `-'.
+    (when (and partial-completion-mode (not (eobp)))
+      (setq mbuf-contents
+           (substring mbuf-contents 0 (- (point) (point-max)))))
     (with-current-buffer standard-output
       (completion-list-mode)
       (make-local-variable 'completion-reference-buffer)
@@ -4283,7 +4338,7 @@ of the differing parts is, by contrast, slightly highlighted."
                (with-current-buffer mainbuf
                  (save-excursion
                    (goto-char (point-max))
-                   (skip-chars-backward "^/")
+                   (skip-chars-backward completion-root-regexp)
                    (- (point) (minibuffer-prompt-end)))))
        ;; Otherwise, in minibuffer, the whole input is being completed.
        (if (minibufferp mainbuf)