mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-24 10:38:38 +00:00
Code Issues Releases Activity

(completion-all-completions-with-base-size): Remove.

Browse Source 
(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.
This commit is contained in:
Stefan Monnier 2008-12-21 05:20:06 +00:00
parent 5e252df234
commit 125f795168
4 changed files with 59 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
etc/NEWS
View File

@ -1345,12 +1345,6 @@ via M-n when reading a regexp in the minibuffer.
*** minibuffer-local-must-match-filename-map is now named *** minibuffer-local-must-match-filename-map is now named
minibuffer-local-filename-must-match-map. 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 *** The `require-match' argument to `completing-read' accepts the new
values `confirm-only' and `confirm-after-completion'. values `confirm-only' and `confirm-after-completion'.

17
lisp/ChangeLog
View File

@ -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> 2008-12-20 Agustin Martin <agustin.martin@hispalinux.es>
* textmodes/ispell.el (ispell-check-minver): New function. * textmodes/ispell.el (ispell-check-minver): New function.
@ -11,8 +24,8 @@
2008-12-20 Jason Rumney <jasonr@gnu.org> 2008-12-20 Jason Rumney <jasonr@gnu.org>
* international/mule.el (auto-coding-regexp-alist): Use * international/mule.el (auto-coding-regexp-alist):
utf-8-with-signature for files starting with UTF-8 BOM. Use utf-8-with-signature for files starting with UTF-8 BOM.
2008-12-20 Ami Fischman <ami@fischman.org> 2008-12-20 Ami Fischman <ami@fischman.org>

101
lisp/minibuffer.el
View File

@ -25,8 +25,6 @@
;; internal use only. ;; internal use only.
;; Functional completion tables have an extended calling conventions: ;; 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 ;; - The `action' can be (additionally to nil, t, and lambda) of the form
;; (boundaries . SUFFIX) in which case it should return ;; (boundaries . SUFFIX) in which case it should return
;; (boundaries START . END). See `completion-boundaries'. ;; (boundaries START . END). See `completion-boundaries'.
@ -58,11 +56,6 @@
(eval-when-compile (require 'cl)) (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 ;;; Completion table manipulation
;; New completion-table operation. ;; New completion-table operation.
@ -176,13 +169,6 @@ You should give VAR a non-nil `risky-local-variable' property."
(cond (cond
;; In case of try-completion, add the prefix. ;; In case of try-completion, add the prefix.
((stringp comp) (concat prefix comp)) ((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))))) (t comp)))))
(defun completion-table-with-terminator (terminator table string pred action) (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."
;; consistent so pcm can merge the `all' output to get the `try' output, ;; 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 ;; but that sometimes clashes with the need for `all' output to look
;; good in *Completions*. ;; good in *Completions*.
;; (let* ((all (all-completions string table pred)) ;; (mapcar (lambda (s) (concat s terminator))
;; (last (last all)) ;; (all-completions string table pred))))
;; (base-size (cdr last)))
;; (when all
;; (setcdr all nil)
;; (nconc (mapcar (lambda (s) (concat s terminator)) all) base-size)))
(all-completions string table pred)) (all-completions string table pred))
;; completion-table-with-terminator is always used for ;; completion-table-with-terminator is always used for
;; "sub-completions" so it's only called if the terminator is missing, ;; "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.
POINT is the position of point within STRING. POINT is the position of point within STRING.
The return value is a list of completions and may contain the base-size The return value is a list of completions and may contain the base-size
in the last `cdr'." in the last `cdr'."
(let ((completion-all-completions-with-base-size t)) ;; The property `completion-styles' indicates that this functional
;; The property `completion-styles' indicates that this functional ;; completion-table claims to take care of completion styles itself.
;; completion-table claims to take care of completion styles itself. ;; [I.e. It will most likely call us back at some point. ]
;; [I.e. It will most likely call us back at some point. ] (if (and (symbolp table) (get table 'completion-styles))
(if (and (symbolp table) (get table 'completion-styles)) ;; Extended semantics for functional completion-tables:
;; Extended semantics for functional completion-tables: ;; They accept a 4th argument `point' and when called with action=t
;; They accept a 4th argument `point' and when called with action=t ;; and this 4th argument (a position inside `string'), they may
;; and this 4th argument (a position inside `string'), they may ;; return BASE-SIZE in the last `cdr'.
;; return BASE-SIZE in the last `cdr'. (funcall table string pred t point)
(funcall table string pred t point) (completion--some (lambda (style)
(completion--some (lambda (style) (funcall (nth 2 (assq style completion-styles-alist))
(funcall (nth 2 (assq style completion-styles-alist)) string table pred point))
string table pred point)) completion-styles)))
completion-styles))))
(defun minibuffer--bitset (modified completions exact) (defun minibuffer--bitset (modified completions exact)
(logior (if modified 4 0) (logior (if modified 4 0)
@ -793,13 +774,9 @@ make the common parts less visible than normal, so that the rest
of the differing parts is, by contrast, slightly highlighted." of the differing parts is, by contrast, slightly highlighted."
:group 'completion) :group 'completion)
(defun completion-hilit-commonality (completions prefix-len) (defun completion-hilit-commonality (completions prefix-len base-size)
(when completions (when completions
(let* ((last (last completions)) (let ((com-str-len (- prefix-len (or base-size 0))))
(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)
(nconc (nconc
(mapcar (mapcar
(lambda (elem) (lambda (elem)
@ -841,7 +818,9 @@ specifying a common substring for adding the faces
the completions buffer." the completions buffer."
(if common-substring (if common-substring
(setq completions (completion-hilit-commonality (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)) (if (not (bufferp standard-output))
;; This *never* (ever) happens, so there's no point trying to be clever. ;; This *never* (ever) happens, so there's no point trying to be clever.
(with-temp-buffer (with-temp-buffer
@ -1035,10 +1014,7 @@ the completions buffer."
str)))) str))))
((eq action t) ((eq action t)
(let ((all (file-name-all-completions name realdir)) (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))))
;; Check the predicate, if necessary. ;; Check the predicate, if necessary.
(unless (memq read-file-name-predicate '(nil file-exists-p)) (unless (memq read-file-name-predicate '(nil file-exists-p))
@ -1057,10 +1033,7 @@ the completions buffer."
(if (funcall pred tem) (push tem comp)))) (if (funcall pred tem) (push tem comp))))
(setq all (nreverse comp)))) (setq all (nreverse comp))))
(if (and completion-all-completions-with-base-size (consp all)) all))
;; Add base-size, but only if the list is non-empty.
(nconc all base-size)
all)))
(t (t
;; Only other case actually used is ACTION = lambda. ;; Only other case actually used is ACTION = lambda.
@ -1251,7 +1224,8 @@ Like `internal-complete-buffer', but removes BUFFER from the completion list."
(defun completion-emacs21-all-completions (string table pred point) (defun completion-emacs21-all-completions (string table pred point)
(completion-hilit-commonality (completion-hilit-commonality
(all-completions string table pred) (all-completions string table pred)
(length string))) (length string)
(car (completion-boundaries string table pred ""))))
(defun completion-emacs22-try-completion (string table pred point) (defun completion-emacs22-try-completion (string table pred point)
(let ((suffix (substring string point)) (let ((suffix (substring string point))
@ -1274,9 +1248,11 @@ Like `internal-complete-buffer', but removes BUFFER from the completion list."
(cons (concat completion suffix) (length completion))))) (cons (concat completion suffix) (length completion)))))
(defun completion-emacs22-all-completions (string table pred point) (defun completion-emacs22-all-completions (string table pred point)
(completion-hilit-commonality (let ((beforepoint (substring string 0 point)))
(all-completions (substring string 0 point) table pred) (completion-hilit-commonality
point)) (all-completions beforepoint table pred)
point
(car (completion-boundaries beforepoint table pred "")))))
;;; Basic completion. ;;; Basic completion.
@ -1331,9 +1307,7 @@ Return the new suffix."
'point 'point
(substring afterpoint 0 (cdr bounds))))) (substring afterpoint 0 (cdr bounds)))))
(all (completion-pcm--all-completions prefix pattern table pred))) (all (completion-pcm--all-completions prefix pattern table pred)))
(completion-hilit-commonality (completion-hilit-commonality all point (car bounds))))
(if (consp all) (nconc all (car bounds)) all)
point)))
;;; Partial-completion-mode style completion. ;;; Partial-completion-mode style completion.
@ -1409,14 +1383,13 @@ or a symbol chosen among `any', `star', `point'."
(defun completion-pcm--all-completions (prefix pattern table pred) (defun completion-pcm--all-completions (prefix pattern table pred)
"Find all completions for PATTERN in TABLE obeying PRED. "Find all completions for PATTERN in TABLE obeying PRED.
PATTERN is as returned by `completion-pcm--string->pattern'." 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. ;; Find an initial list of possible completions.
(if (completion-pcm--pattern-trivial-p pattern) (if (completion-pcm--pattern-trivial-p pattern)
;; Minibuffer contains no delimiters -- simple case! ;; Minibuffer contains no delimiters -- simple case!
(let* ((all (all-completions (concat prefix (car pattern)) table pred)) (all-completions (concat prefix (car pattern)) table pred)
(last (last all)))
(if last (setcdr last nil))
all)
;; Use all-completions to do an initial cull. This is a big win, ;; Use all-completions to do an initial cull. This is a big win,
;; since all-completions is written in C! ;; since all-completions is written in C!
@ -1426,13 +1399,7 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
(completion-regexp-list (cons regex completion-regexp-list)) (completion-regexp-list (cons regex completion-regexp-list))
(compl (all-completions (compl (all-completions
(concat prefix (if (stringp (car pattern)) (car pattern) "")) (concat prefix (if (stringp (car pattern)) (car pattern) ""))
table pred)) 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))
(if (not (functionp table)) (if (not (functionp table))
;; The internal functions already obeyed completion-regexp-list. ;; The internal functions already obeyed completion-regexp-list.
compl compl

13
lisp/simple.el
View File

@ -3587,6 +3587,11 @@ after C-u \\[set-mark-command]."
:type 'boolean :type 'boolean
:group 'editing-basics) :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) (defun set-mark-command (arg)
"Set the mark where point is, or jump to the mark. "Set the mark where point is, or jump to the mark.
Setting the mark also alters the region, which is the text Setting the mark also alters the region, which is the text
@ -3648,7 +3653,8 @@ purposes. See the documentation of `set-mark' for more information."
(activate-mark) (activate-mark)
(message "Mark activated"))) (message "Mark activated")))
(t (t
(push-mark-command nil)))) (push-mark-command nil)
(if set-mark-default-inactive (deactivate-mark)))))
(defun push-mark (&optional location nomsg activate) (defun push-mark (&optional location nomsg activate)
"Set mark at LOCATION (point, by default) and push old mark on mark ring. "Set mark at LOCATION (point, by default) and push old mark on mark ring.
@ -3711,6 +3717,7 @@ mode temporarily."
(deactivate-mark) (deactivate-mark)
(set-mark (point)) (set-mark (point))
(goto-char omark) (goto-char omark)
(if set-mark-default-inactive (deactivate-mark))
(cond (temp-highlight (cond (temp-highlight
(setq transient-mark-mode (cons 'only transient-mark-mode))) (setq transient-mark-mode (cons 'only transient-mark-mode)))
((or (and arg (region-active-p)) ; (xor arg (not (region-active-p))) ((or (and arg (region-active-p)) ; (xor arg (not (region-active-p)))
@ -5787,8 +5794,8 @@ Called from `temp-buffer-show-hook'."
(set (make-local-variable 'completion-base-size) base-size)) (set (make-local-variable 'completion-base-size) base-size))
(set (make-local-variable 'completion-reference-buffer) mainbuf) (set (make-local-variable 'completion-reference-buffer) mainbuf)
(unless completion-base-size (unless completion-base-size
;; This may be needed for old completion packages which don't use ;; This shouldn't be needed any more, but further analysis is needed
;; completion-all-completions-with-base-size yet. ;; to make sure it's the case.
(setq completion-base-size (setq completion-base-size
(cond (cond
(minibuffer-completing-file-name (minibuffer-completing-file-name