changeset 100623:5a144164af93

(completion-all-completions-with-base-size): Remove. (completion-all-completions): Don't set it. (completion-table-with-context, completion--file-name-table): Don't add base-size in last cdr. (completion-hilit-commonality): Add argument `base-size'. (display-completion-list, completion-emacs21-all-completions) (completion-emacs22-all-completions, completion-basic-all-completions): Provide it. (completion-pcm--all-completions): Don't need to remove the base-size in last-cdr any more.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Sun, 21 Dec 2008 05:20:06 +0000
parents c236484e9c94
children fb40d63bb761
files etc/NEWS lisp/ChangeLog lisp/minibuffer.el lisp/simple.el
diffstat 4 files changed, 59 insertions(+), 78 deletions(-) [+]
line wrap: on
line diff
--- a/etc/NEWS	Sun Dec 21 04:13:46 2008 +0000
+++ b/etc/NEWS	Sun Dec 21 05:20:06 2008 +0000
@@ -1345,12 +1345,6 @@
 *** minibuffer-local-must-match-filename-map is now named
 minibuffer-local-filename-must-match-map.
 
----
-*** `all-completions' may now return the base size in the last cdr.
-Since this means the returned list is not properly nil-terminated, this
-is an incompatible change and is thus enabled by the new variable
-completion-all-completions-with-base-size.
-
 +++
 *** The `require-match' argument to `completing-read' accepts the new
 values `confirm-only' and `confirm-after-completion'.
--- a/lisp/ChangeLog	Sun Dec 21 04:13:46 2008 +0000
+++ b/lisp/ChangeLog	Sun Dec 21 05:20:06 2008 +0000
@@ -1,3 +1,16 @@
+2008-12-21  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* minibuffer.el (completion-all-completions-with-base-size): Remove.
+	(completion-all-completions): Don't set it.
+	(completion-table-with-context, completion--file-name-table):
+	Don't add base-size in last cdr.
+	(completion-hilit-commonality): Add argument `base-size'.
+	(display-completion-list, completion-emacs21-all-completions)
+	(completion-emacs22-all-completions, completion-basic-all-completions):
+	Provide it.
+	(completion-pcm--all-completions): Don't need to remove the base-size
+	in last-cdr any more.
+
 2008-12-20  Agustin Martin <agustin.martin@hispalinux.es>
 
 	* textmodes/ispell.el (ispell-check-minver): New function.
@@ -11,8 +24,8 @@
 
 2008-12-20  Jason Rumney  <jasonr@gnu.org>
 
-	* international/mule.el (auto-coding-regexp-alist): Use
-	utf-8-with-signature for files starting with UTF-8 BOM.
+	* international/mule.el (auto-coding-regexp-alist):
+	Use utf-8-with-signature for files starting with UTF-8 BOM.
 
 2008-12-20  Ami Fischman  <ami@fischman.org>
 
--- a/lisp/minibuffer.el	Sun Dec 21 04:13:46 2008 +0000
+++ b/lisp/minibuffer.el	Sun Dec 21 05:20:06 2008 +0000
@@ -25,8 +25,6 @@
 ;; internal use only.
 
 ;; Functional completion tables have an extended calling conventions:
-;; - If completion-all-completions-with-base-size is set, then all-completions
-;;   should return the base-size in the last cdr.
 ;; - The `action' can be (additionally to nil, t, and lambda) of the form
 ;;   (boundaries . SUFFIX) in which case it should return
 ;;   (boundaries START . END).  See `completion-boundaries'.
@@ -58,11 +56,6 @@
 
 (eval-when-compile (require 'cl))
 
-(defvar completion-all-completions-with-base-size nil
-  "If non-nil, `all-completions' may return the base-size in the last cdr.
-The base-size is the length of the prefix that is elided from each
-element in the returned list of completions.  See `completion-base-size'.")
-
 ;;; Completion table manipulation
 
 ;; New completion-table operation.
@@ -176,13 +169,6 @@
       (cond
        ;; In case of try-completion, add the prefix.
        ((stringp comp) (concat prefix comp))
-       ;; In case of non-empty all-completions,
-       ;; add the prefix size to the base-size.
-       ((consp comp)
-        (let ((last (last comp)))
-          (when completion-all-completions-with-base-size
-            (setcdr last (+ (or (cdr last) 0) (length prefix))))
-          comp))
        (t comp)))))
 
 (defun completion-table-with-terminator (terminator table string pred action)
@@ -200,12 +186,8 @@
     ;; consistent so pcm can merge the `all' output to get the `try' output,
     ;; but that sometimes clashes with the need for `all' output to look
     ;; good in *Completions*.
-    ;; (let* ((all (all-completions string table pred))
-    ;;        (last (last all))
-    ;;        (base-size (cdr last)))
-    ;;   (when all
-    ;;     (setcdr all nil)
-    ;;     (nconc (mapcar (lambda (s) (concat s terminator)) all) base-size)))
+    ;; (mapcar (lambda (s) (concat s terminator))
+    ;;         (all-completions string table pred))))
     (all-completions string table pred))
    ;; completion-table-with-terminator is always used for
    ;; "sub-completions" so it's only called if the terminator is missing,
@@ -360,20 +342,19 @@
 POINT is the position of point within STRING.
 The return value is a list of completions and may contain the base-size
 in the last `cdr'."
-  (let ((completion-all-completions-with-base-size t))
-    ;; The property `completion-styles' indicates that this functional
-    ;; completion-table claims to take care of completion styles itself.
-    ;; [I.e. It will most likely call us back at some point. ]
-    (if (and (symbolp table) (get table 'completion-styles))
-        ;; Extended semantics for functional completion-tables:
-        ;; They accept a 4th argument `point' and when called with action=t
-        ;; and this 4th argument (a position inside `string'), they may
-        ;; return BASE-SIZE in the last `cdr'.
-        (funcall table string pred t point)
-      (completion--some (lambda (style)
-                          (funcall (nth 2 (assq style completion-styles-alist))
-                                   string table pred point))
-                        completion-styles))))
+  ;; The property `completion-styles' indicates that this functional
+  ;; completion-table claims to take care of completion styles itself.
+  ;; [I.e. It will most likely call us back at some point. ]
+  (if (and (symbolp table) (get table 'completion-styles))
+      ;; Extended semantics for functional completion-tables:
+      ;; They accept a 4th argument `point' and when called with action=t
+      ;; and this 4th argument (a position inside `string'), they may
+      ;; return BASE-SIZE in the last `cdr'.
+      (funcall table string pred t point)
+    (completion--some (lambda (style)
+                        (funcall (nth 2 (assq style completion-styles-alist))
+                                 string table pred point))
+                      completion-styles)))
 
 (defun minibuffer--bitset (modified completions exact)
   (logior (if modified    4 0)
@@ -793,13 +774,9 @@
 of the differing parts is, by contrast, slightly highlighted."
   :group 'completion)
 
-(defun completion-hilit-commonality (completions prefix-len)
+(defun completion-hilit-commonality (completions prefix-len base-size)
   (when completions
-    (let* ((last (last completions))
-           (base-size (cdr last))
-           (com-str-len (- prefix-len (or base-size 0))))
-      ;; Remove base-size during mapcar, and add it back later.
-      (setcdr last nil)
+    (let ((com-str-len (- prefix-len (or base-size 0))))
       (nconc
        (mapcar
         (lambda (elem)
@@ -841,7 +818,9 @@
 the completions buffer."
   (if common-substring
       (setq completions (completion-hilit-commonality
-                         completions (length common-substring))))
+                         completions (length common-substring)
+                         ;; We don't know the base-size.
+                         nil)))
   (if (not (bufferp standard-output))
       ;; This *never* (ever) happens, so there's no point trying to be clever.
       (with-temp-buffer
@@ -1035,10 +1014,7 @@
               str))))
 
        ((eq action t)
-        (let ((all (file-name-all-completions name realdir))
-              ;; FIXME: Actually, this is not always right in the presence
-              ;; of envvars, but there's not much we can do, I think.
-              (base-size (length (file-name-directory string))))
+        (let ((all (file-name-all-completions name realdir)))
 
           ;; Check the predicate, if necessary.
           (unless (memq read-file-name-predicate '(nil file-exists-p))
@@ -1057,10 +1033,7 @@
                   (if (funcall pred tem) (push tem comp))))
               (setq all (nreverse comp))))
 
-          (if (and completion-all-completions-with-base-size (consp all))
-              ;; Add base-size, but only if the list is non-empty.
-              (nconc all base-size)
-            all)))
+          all))
 
        (t
         ;; Only other case actually used is ACTION = lambda.
@@ -1251,7 +1224,8 @@
 (defun completion-emacs21-all-completions (string table pred point)
   (completion-hilit-commonality
    (all-completions string table pred)
-   (length string)))
+   (length string)
+   (car (completion-boundaries string table pred ""))))
 
 (defun completion-emacs22-try-completion (string table pred point)
   (let ((suffix (substring string point))
@@ -1274,9 +1248,11 @@
       (cons (concat completion suffix) (length completion)))))
 
 (defun completion-emacs22-all-completions (string table pred point)
-  (completion-hilit-commonality
-   (all-completions (substring string 0 point) table pred)
-   point))
+  (let ((beforepoint (substring string 0 point)))
+    (completion-hilit-commonality
+     (all-completions beforepoint table pred)
+     point
+     (car (completion-boundaries beforepoint table pred "")))))
 
 ;;; Basic completion.
 
@@ -1331,9 +1307,7 @@
                             'point
                             (substring afterpoint 0 (cdr bounds)))))
          (all (completion-pcm--all-completions prefix pattern table pred)))
-    (completion-hilit-commonality
-     (if (consp all) (nconc all (car bounds)) all)
-     point)))
+    (completion-hilit-commonality all point (car bounds))))
 
 ;;; Partial-completion-mode style completion.
 
@@ -1409,14 +1383,13 @@
 (defun completion-pcm--all-completions (prefix pattern table pred)
   "Find all completions for PATTERN in TABLE obeying PRED.
 PATTERN is as returned by `completion-pcm--string->pattern'."
+  ;; (assert (= (car (completion-boundaries prefix table pred ""))
+  ;;            (length prefix)))
   ;; Find an initial list of possible completions.
   (if (completion-pcm--pattern-trivial-p pattern)
 
       ;; Minibuffer contains no delimiters -- simple case!
-      (let* ((all (all-completions (concat prefix (car pattern)) table pred))
-             (last (last all)))
-        (if last (setcdr last nil))
-        all)
+      (all-completions (concat prefix (car pattern)) table pred)
 
     ;; Use all-completions to do an initial cull.  This is a big win,
     ;; since all-completions is written in C!
@@ -1426,13 +1399,7 @@
            (completion-regexp-list (cons regex completion-regexp-list))
 	   (compl (all-completions
                    (concat prefix (if (stringp (car pattern)) (car pattern) ""))
-		   table pred))
-           (last (last compl)))
-      (when last
-        (if (and (numberp (cdr last)) (/= (cdr last) (length prefix)))
-            (message "Inconsistent base-size returned by completion table %s"
-                     table))
-        (setcdr last nil))
+		   table pred)))
       (if (not (functionp table))
 	  ;; The internal functions already obeyed completion-regexp-list.
 	  compl
--- a/lisp/simple.el	Sun Dec 21 04:13:46 2008 +0000
+++ b/lisp/simple.el	Sun Dec 21 05:20:06 2008 +0000
@@ -3587,6 +3587,11 @@
   :type 'boolean
   :group 'editing-basics)
 
+(defcustom set-mark-default-inactive nil
+  "If non-nil, setting the mark does not activate it.
+This causes \\[set-mark-command] and \\[exchange-point-and-mark] to
+behave the same whether or not `transient-mark-mode' is enabled.")
+
 (defun set-mark-command (arg)
   "Set the mark where point is, or jump to the mark.
 Setting the mark also alters the region, which is the text
@@ -3648,7 +3653,8 @@
       (activate-mark)
       (message "Mark activated")))
    (t
-    (push-mark-command nil))))
+    (push-mark-command nil)
+    (if set-mark-default-inactive (deactivate-mark)))))
 
 (defun push-mark (&optional location nomsg activate)
   "Set mark at LOCATION (point, by default) and push old mark on mark ring.
@@ -3711,6 +3717,7 @@
     (deactivate-mark)
     (set-mark (point))
     (goto-char omark)
+    (if set-mark-default-inactive (deactivate-mark))
     (cond (temp-highlight
 	   (setq transient-mark-mode (cons 'only transient-mark-mode)))
 	  ((or (and arg (region-active-p)) ; (xor arg (not (region-active-p)))
@@ -5787,8 +5794,8 @@
         (set (make-local-variable 'completion-base-size) base-size))
       (set (make-local-variable 'completion-reference-buffer) mainbuf)
       (unless completion-base-size
-        ;; This may be needed for old completion packages which don't use
-        ;; completion-all-completions-with-base-size yet.
+        ;; This shouldn't be needed any more, but further analysis is needed
+        ;; to make sure it's the case.
         (setq completion-base-size
               (cond
                (minibuffer-completing-file-name