aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2008-12-21 05:20:06 +0000
committerStefan Monnier2008-12-21 05:20:06 +0000
commit125f795168b05fa6297abf2090a88c2200d6d5d3 (patch)
treeedd47b61c91155d443a0a2b1ada3f6d471a0144a
parent5e252df23484d60af95fb3efce226971c2e988d4 (diff)
downloademacs-125f795168b05fa6297abf2090a88c2200d6d5d3.tar.gz
emacs-125f795168b05fa6297abf2090a88c2200d6d5d3.zip
(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.
-rw-r--r--etc/NEWS6
-rw-r--r--lisp/ChangeLog17
-rw-r--r--lisp/minibuffer.el101
-rw-r--r--lisp/simple.el13
4 files changed, 59 insertions, 78 deletions
diff --git a/etc/NEWS b/etc/NEWS
index db0f4e941b4..eaeea4195dc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1345,12 +1345,6 @@ via M-n when reading a regexp in the minibuffer.
1345*** minibuffer-local-must-match-filename-map is now named 1345*** minibuffer-local-must-match-filename-map is now named
1346minibuffer-local-filename-must-match-map. 1346minibuffer-local-filename-must-match-map.
1347 1347
1348---
1349*** `all-completions' may now return the base size in the last cdr.
1350Since this means the returned list is not properly nil-terminated, this
1351is an incompatible change and is thus enabled by the new variable
1352completion-all-completions-with-base-size.
1353
1354+++ 1348+++
1355*** The `require-match' argument to `completing-read' accepts the new 1349*** The `require-match' argument to `completing-read' accepts the new
1356values `confirm-only' and `confirm-after-completion'. 1350values `confirm-only' and `confirm-after-completion'.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c16f7bcc2b4..c05cc4102e4 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,16 @@
12008-12-21 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * minibuffer.el (completion-all-completions-with-base-size): Remove.
4 (completion-all-completions): Don't set it.
5 (completion-table-with-context, completion--file-name-table):
6 Don't add base-size in last cdr.
7 (completion-hilit-commonality): Add argument `base-size'.
8 (display-completion-list, completion-emacs21-all-completions)
9 (completion-emacs22-all-completions, completion-basic-all-completions):
10 Provide it.
11 (completion-pcm--all-completions): Don't need to remove the base-size
12 in last-cdr any more.
13
12008-12-20 Agustin Martin <agustin.martin@hispalinux.es> 142008-12-20 Agustin Martin <agustin.martin@hispalinux.es>
2 15
3 * textmodes/ispell.el (ispell-check-minver): New function. 16 * textmodes/ispell.el (ispell-check-minver): New function.
@@ -11,8 +24,8 @@
11 24
122008-12-20 Jason Rumney <jasonr@gnu.org> 252008-12-20 Jason Rumney <jasonr@gnu.org>
13 26
14 * international/mule.el (auto-coding-regexp-alist): Use 27 * international/mule.el (auto-coding-regexp-alist):
15 utf-8-with-signature for files starting with UTF-8 BOM. 28 Use utf-8-with-signature for files starting with UTF-8 BOM.
16 29
172008-12-20 Ami Fischman <ami@fischman.org> 302008-12-20 Ami Fischman <ami@fischman.org>
18 31
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index c52af234616..407bb5ccb8b 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -25,8 +25,6 @@
25;; internal use only. 25;; internal use only.
26 26
27;; Functional completion tables have an extended calling conventions: 27;; Functional completion tables have an extended calling conventions:
28;; - If completion-all-completions-with-base-size is set, then all-completions
29;; should return the base-size in the last cdr.
30;; - The `action' can be (additionally to nil, t, and lambda) of the form 28;; - The `action' can be (additionally to nil, t, and lambda) of the form
31;; (boundaries . SUFFIX) in which case it should return 29;; (boundaries . SUFFIX) in which case it should return
32;; (boundaries START . END). See `completion-boundaries'. 30;; (boundaries START . END). See `completion-boundaries'.
@@ -58,11 +56,6 @@
58 56
59(eval-when-compile (require 'cl)) 57(eval-when-compile (require 'cl))
60 58
61(defvar completion-all-completions-with-base-size nil
62 "If non-nil, `all-completions' may return the base-size in the last cdr.
63The base-size is the length of the prefix that is elided from each
64element in the returned list of completions. See `completion-base-size'.")
65
66;;; Completion table manipulation 59;;; Completion table manipulation
67 60
68;; New completion-table operation. 61;; New completion-table operation.
@@ -176,13 +169,6 @@ You should give VAR a non-nil `risky-local-variable' property."
176 (cond 169 (cond
177 ;; In case of try-completion, add the prefix. 170 ;; In case of try-completion, add the prefix.
178 ((stringp comp) (concat prefix comp)) 171 ((stringp comp) (concat prefix comp))
179 ;; In case of non-empty all-completions,
180 ;; add the prefix size to the base-size.
181 ((consp comp)
182 (let ((last (last comp)))
183 (when completion-all-completions-with-base-size
184 (setcdr last (+ (or (cdr last) 0) (length prefix))))
185 comp))
186 (t comp))))) 172 (t comp)))))
187 173
188(defun completion-table-with-terminator (terminator table string pred action) 174(defun completion-table-with-terminator (terminator table string pred action)
@@ -200,12 +186,8 @@ You should give VAR a non-nil `risky-local-variable' property."
200 ;; consistent so pcm can merge the `all' output to get the `try' output, 186 ;; consistent so pcm can merge the `all' output to get the `try' output,
201 ;; but that sometimes clashes with the need for `all' output to look 187 ;; but that sometimes clashes with the need for `all' output to look
202 ;; good in *Completions*. 188 ;; good in *Completions*.
203 ;; (let* ((all (all-completions string table pred)) 189 ;; (mapcar (lambda (s) (concat s terminator))
204 ;; (last (last all)) 190 ;; (all-completions string table pred))))
205 ;; (base-size (cdr last)))
206 ;; (when all
207 ;; (setcdr all nil)
208 ;; (nconc (mapcar (lambda (s) (concat s terminator)) all) base-size)))
209 (all-completions string table pred)) 191 (all-completions string table pred))
210 ;; completion-table-with-terminator is always used for 192 ;; completion-table-with-terminator is always used for
211 ;; "sub-completions" so it's only called if the terminator is missing, 193 ;; "sub-completions" so it's only called if the terminator is missing,
@@ -360,20 +342,19 @@ Only the elements of table that satisfy predicate PRED are considered.
360POINT is the position of point within STRING. 342POINT is the position of point within STRING.
361The return value is a list of completions and may contain the base-size 343The return value is a list of completions and may contain the base-size
362in the last `cdr'." 344in the last `cdr'."
363 (let ((completion-all-completions-with-base-size t)) 345 ;; The property `completion-styles' indicates that this functional
364 ;; The property `completion-styles' indicates that this functional 346 ;; completion-table claims to take care of completion styles itself.
365 ;; completion-table claims to take care of completion styles itself. 347 ;; [I.e. It will most likely call us back at some point. ]
366 ;; [I.e. It will most likely call us back at some point. ] 348 (if (and (symbolp table) (get table 'completion-styles))
367 (if (and (symbolp table) (get table 'completion-styles)) 349 ;; Extended semantics for functional completion-tables:
368 ;; Extended semantics for functional completion-tables: 350 ;; They accept a 4th argument `point' and when called with action=t
369 ;; They accept a 4th argument `point' and when called with action=t 351 ;; and this 4th argument (a position inside `string'), they may
370 ;; and this 4th argument (a position inside `string'), they may 352 ;; return BASE-SIZE in the last `cdr'.
371 ;; return BASE-SIZE in the last `cdr'. 353 (funcall table string pred t point)
372 (funcall table string pred t point) 354 (completion--some (lambda (style)
373 (completion--some (lambda (style) 355 (funcall (nth 2 (assq style completion-styles-alist))
374 (funcall (nth 2 (assq style completion-styles-alist)) 356 string table pred point))
375 string table pred point)) 357 completion-styles)))
376 completion-styles))))
377 358
378(defun minibuffer--bitset (modified completions exact) 359(defun minibuffer--bitset (modified completions exact)
379 (logior (if modified 4 0) 360 (logior (if modified 4 0)
@@ -793,13 +774,9 @@ make the common parts less visible than normal, so that the rest
793of the differing parts is, by contrast, slightly highlighted." 774of the differing parts is, by contrast, slightly highlighted."
794 :group 'completion) 775 :group 'completion)
795 776
796(defun completion-hilit-commonality (completions prefix-len) 777(defun completion-hilit-commonality (completions prefix-len base-size)
797 (when completions 778 (when completions
798 (let* ((last (last completions)) 779 (let ((com-str-len (- prefix-len (or base-size 0))))
799 (base-size (cdr last))
800 (com-str-len (- prefix-len (or base-size 0))))
801 ;; Remove base-size during mapcar, and add it back later.
802 (setcdr last nil)
803 (nconc 780 (nconc
804 (mapcar 781 (mapcar
805 (lambda (elem) 782 (lambda (elem)
@@ -841,7 +818,9 @@ specifying a common substring for adding the faces
841the completions buffer." 818the completions buffer."
842 (if common-substring 819 (if common-substring
843 (setq completions (completion-hilit-commonality 820 (setq completions (completion-hilit-commonality
844 completions (length common-substring)))) 821 completions (length common-substring)
822 ;; We don't know the base-size.
823 nil)))
845 (if (not (bufferp standard-output)) 824 (if (not (bufferp standard-output))
846 ;; This *never* (ever) happens, so there's no point trying to be clever. 825 ;; This *never* (ever) happens, so there's no point trying to be clever.
847 (with-temp-buffer 826 (with-temp-buffer
@@ -1035,10 +1014,7 @@ the completions buffer."
1035 str)))) 1014 str))))
1036 1015
1037 ((eq action t) 1016 ((eq action t)
1038 (let ((all (file-name-all-completions name realdir)) 1017 (let ((all (file-name-all-completions name realdir)))
1039 ;; FIXME: Actually, this is not always right in the presence
1040 ;; of envvars, but there's not much we can do, I think.
1041 (base-size (length (file-name-directory string))))
1042 1018
1043 ;; Check the predicate, if necessary. 1019 ;; Check the predicate, if necessary.
1044 (unless (memq read-file-name-predicate '(nil file-exists-p)) 1020 (unless (memq read-file-name-predicate '(nil file-exists-p))
@@ -1057,10 +1033,7 @@ the completions buffer."
1057 (if (funcall pred tem) (push tem comp)))) 1033 (if (funcall pred tem) (push tem comp))))
1058 (setq all (nreverse comp)))) 1034 (setq all (nreverse comp))))
1059 1035
1060 (if (and completion-all-completions-with-base-size (consp all)) 1036 all))
1061 ;; Add base-size, but only if the list is non-empty.
1062 (nconc all base-size)
1063 all)))
1064 1037
1065 (t 1038 (t
1066 ;; Only other case actually used is ACTION = lambda. 1039 ;; Only other case actually used is ACTION = lambda.
@@ -1251,7 +1224,8 @@ Like `internal-complete-buffer', but removes BUFFER from the completion list."
1251(defun completion-emacs21-all-completions (string table pred point) 1224(defun completion-emacs21-all-completions (string table pred point)
1252 (completion-hilit-commonality 1225 (completion-hilit-commonality
1253 (all-completions string table pred) 1226 (all-completions string table pred)
1254 (length string))) 1227 (length string)
1228 (car (completion-boundaries string table pred ""))))
1255 1229
1256(defun completion-emacs22-try-completion (string table pred point) 1230(defun completion-emacs22-try-completion (string table pred point)
1257 (let ((suffix (substring string point)) 1231 (let ((suffix (substring string point))
@@ -1274,9 +1248,11 @@ Like `internal-complete-buffer', but removes BUFFER from the completion list."
1274 (cons (concat completion suffix) (length completion))))) 1248 (cons (concat completion suffix) (length completion)))))
1275 1249
1276(defun completion-emacs22-all-completions (string table pred point) 1250(defun completion-emacs22-all-completions (string table pred point)
1277 (completion-hilit-commonality 1251 (let ((beforepoint (substring string 0 point)))
1278 (all-completions (substring string 0 point) table pred) 1252 (completion-hilit-commonality
1279 point)) 1253 (all-completions beforepoint table pred)
1254 point
1255 (car (completion-boundaries beforepoint table pred "")))))
1280 1256
1281;;; Basic completion. 1257;;; Basic completion.
1282 1258
@@ -1331,9 +1307,7 @@ Return the new suffix."
1331 'point 1307 'point
1332 (substring afterpoint 0 (cdr bounds))))) 1308 (substring afterpoint 0 (cdr bounds)))))
1333 (all (completion-pcm--all-completions prefix pattern table pred))) 1309 (all (completion-pcm--all-completions prefix pattern table pred)))
1334 (completion-hilit-commonality 1310 (completion-hilit-commonality all point (car bounds))))
1335 (if (consp all) (nconc all (car bounds)) all)
1336 point)))
1337 1311
1338;;; Partial-completion-mode style completion. 1312;;; Partial-completion-mode style completion.
1339 1313
@@ -1409,14 +1383,13 @@ or a symbol chosen among `any', `star', `point'."
1409(defun completion-pcm--all-completions (prefix pattern table pred) 1383(defun completion-pcm--all-completions (prefix pattern table pred)
1410 "Find all completions for PATTERN in TABLE obeying PRED. 1384 "Find all completions for PATTERN in TABLE obeying PRED.
1411PATTERN is as returned by `completion-pcm--string->pattern'." 1385PATTERN is as returned by `completion-pcm--string->pattern'."
1386 ;; (assert (= (car (completion-boundaries prefix table pred ""))
1387 ;; (length prefix)))
1412 ;; Find an initial list of possible completions. 1388 ;; Find an initial list of possible completions.
1413 (if (completion-pcm--pattern-trivial-p pattern) 1389 (if (completion-pcm--pattern-trivial-p pattern)
1414 1390
1415 ;; Minibuffer contains no delimiters -- simple case! 1391 ;; Minibuffer contains no delimiters -- simple case!
1416 (let* ((all (all-completions (concat prefix (car pattern)) table pred)) 1392 (all-completions (concat prefix (car pattern)) table pred)
1417 (last (last all)))
1418 (if last (setcdr last nil))
1419 all)
1420 1393
1421 ;; Use all-completions to do an initial cull. This is a big win, 1394 ;; Use all-completions to do an initial cull. This is a big win,
1422 ;; since all-completions is written in C! 1395 ;; since all-completions is written in C!
@@ -1426,13 +1399,7 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
1426 (completion-regexp-list (cons regex completion-regexp-list)) 1399 (completion-regexp-list (cons regex completion-regexp-list))
1427 (compl (all-completions 1400 (compl (all-completions
1428 (concat prefix (if (stringp (car pattern)) (car pattern) "")) 1401 (concat prefix (if (stringp (car pattern)) (car pattern) ""))
1429 table pred)) 1402 table pred)))
1430 (last (last compl)))
1431 (when last
1432 (if (and (numberp (cdr last)) (/= (cdr last) (length prefix)))
1433 (message "Inconsistent base-size returned by completion table %s"
1434 table))
1435 (setcdr last nil))
1436 (if (not (functionp table)) 1403 (if (not (functionp table))
1437 ;; The internal functions already obeyed completion-regexp-list. 1404 ;; The internal functions already obeyed completion-regexp-list.
1438 compl 1405 compl
diff --git a/lisp/simple.el b/lisp/simple.el
index 357de51a3db..386de773849 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -3587,6 +3587,11 @@ after C-u \\[set-mark-command]."
3587 :type 'boolean 3587 :type 'boolean
3588 :group 'editing-basics) 3588 :group 'editing-basics)
3589 3589
3590(defcustom set-mark-default-inactive nil
3591 "If non-nil, setting the mark does not activate it.
3592This causes \\[set-mark-command] and \\[exchange-point-and-mark] to
3593behave the same whether or not `transient-mark-mode' is enabled.")
3594
3590(defun set-mark-command (arg) 3595(defun set-mark-command (arg)
3591 "Set the mark where point is, or jump to the mark. 3596 "Set the mark where point is, or jump to the mark.
3592Setting the mark also alters the region, which is the text 3597Setting the mark also alters the region, which is the text
@@ -3648,7 +3653,8 @@ purposes. See the documentation of `set-mark' for more information."
3648 (activate-mark) 3653 (activate-mark)
3649 (message "Mark activated"))) 3654 (message "Mark activated")))
3650 (t 3655 (t
3651 (push-mark-command nil)))) 3656 (push-mark-command nil)
3657 (if set-mark-default-inactive (deactivate-mark)))))
3652 3658
3653(defun push-mark (&optional location nomsg activate) 3659(defun push-mark (&optional location nomsg activate)
3654 "Set mark at LOCATION (point, by default) and push old mark on mark ring. 3660 "Set mark at LOCATION (point, by default) and push old mark on mark ring.
@@ -3711,6 +3717,7 @@ mode temporarily."
3711 (deactivate-mark) 3717 (deactivate-mark)
3712 (set-mark (point)) 3718 (set-mark (point))
3713 (goto-char omark) 3719 (goto-char omark)
3720 (if set-mark-default-inactive (deactivate-mark))
3714 (cond (temp-highlight 3721 (cond (temp-highlight
3715 (setq transient-mark-mode (cons 'only transient-mark-mode))) 3722 (setq transient-mark-mode (cons 'only transient-mark-mode)))
3716 ((or (and arg (region-active-p)) ; (xor arg (not (region-active-p))) 3723 ((or (and arg (region-active-p)) ; (xor arg (not (region-active-p)))
@@ -5787,8 +5794,8 @@ Called from `temp-buffer-show-hook'."
5787 (set (make-local-variable 'completion-base-size) base-size)) 5794 (set (make-local-variable 'completion-base-size) base-size))
5788 (set (make-local-variable 'completion-reference-buffer) mainbuf) 5795 (set (make-local-variable 'completion-reference-buffer) mainbuf)
5789 (unless completion-base-size 5796 (unless completion-base-size
5790 ;; This may be needed for old completion packages which don't use 5797 ;; This shouldn't be needed any more, but further analysis is needed
5791 ;; completion-all-completions-with-base-size yet. 5798 ;; to make sure it's the case.
5792 (setq completion-base-size 5799 (setq completion-base-size
5793 (cond 5800 (cond
5794 (minibuffer-completing-file-name 5801 (minibuffer-completing-file-name