;; are meant to be for internal use only.
;; TODO:
-;; - make the `hide-spaces' arg of all-completions obsolete.
-
-;; BUGS:
-;; - envvar completion for file names breaks completion-base-size.
+;; - New command minibuffer-force-complete that chooses one of all-completions.
+;; - make the `hide-spaces' arg of all-completions obsolete?
;;; Code:
(defun completion-table-dynamic (fun)
"Use function FUN as a dynamic completion table.
FUN is called with one argument, the string for which completion is required,
-and it should return an alist containing all the intended possible
-completions. This alist may be a full list of possible completions so that FUN
-can ignore the value of its argument. If completion is performed in the
-minibuffer, FUN will be called in the buffer from which the minibuffer was
-entered.
+and it should return an alist containing all the intended possible completions.
+This alist may be a full list of possible completions so that FUN can ignore
+the value of its argument. If completion is performed in the minibuffer,
+FUN will be called in the buffer from which the minibuffer was entered.
The result of the `dynamic-completion-table' form is a function
that can be used as the ALIST argument to `try-completion' and
-`all-completion'. See Info node `(elisp)Programmed Completion'."
+`all-completions'. See Info node `(elisp)Programmed Completion'."
(lexical-let ((fun fun))
(lambda (string pred action)
(with-current-buffer (let ((win (minibuffer-selected-window)))
,var))))
(defun completion-table-with-context (prefix table string pred action)
- ;; TODO: add `suffix', and think about how we should support `pred'.
+ ;; TODO: add `suffix' maybe?
;; Notice that `pred' is not a predicate when called from read-file-name
;; or Info-read-node-name-2.
- ;; (if pred (setq pred (lexical-let ((pred pred))
- ;; ;; FIXME: this doesn't work if `table' is an obarray.
- ;; (lambda (s) (funcall pred (concat prefix s))))))
+ (if (functionp pred)
+ (setq pred (lexical-let ((pred pred))
+ ;; FIXME: this doesn't work if `table' is an obarray.
+ (lambda (s) (funcall pred (concat prefix s))))))
(let ((comp (complete-with-action action table string pred)))
(cond
;; In case of try-completion, add the prefix.
(t comp))))
(defun completion-table-with-terminator (terminator table string pred action)
- (let ((comp (complete-with-action action table string pred)))
- (cond
- ((eq action nil)
+ (cond
+ ((eq action nil)
+ (let ((comp (try-completion string table pred)))
(if (eq comp t)
(concat string terminator)
(if (and (stringp comp)
- (eq (complete-with-action action table comp pred) t))
+ (eq (try-completion comp table pred) t))
(concat comp terminator)
- comp)
- comp))
- ;; completion-table-with-terminator is always used for
- ;; "sub-completions" so it's only called if the terminator is missing,
- ;; in which case `test-completion' should return nil.
- ((eq action 'lambda) nil))))
+ comp))))
+ ((eq action t) (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,
+ ;; in which case `test-completion' should return nil.
+ ((eq action 'lambda) nil)))
+
+(defun completion-table-with-predicate (table pred1 strict string pred2 action)
+ "Make a completion table equivalent to TABLE but filtered through PRED1.
+PRED1 is a function of one argument which returns non-nil iff the
+argument is an element of TABLE which should be considered for completion.
+STRING, PRED2, and ACTION are the usual arguments to completion tables,
+as described in `try-completion', `all-completions', and `test-completion'.
+If STRICT is t, the predicate always applies, if nil it only applies if
+it doesn't reduce the set of possible completions to nothing.
+Note: TABLE needs to be a proper completion table which obeys predicates."
+ (cond
+ ((and (not strict) (eq action 'lambda))
+ ;; Ignore pred1 since it doesn't really have to apply anyway.
+ (test-completion string table pred2))
+ (t
+ (or (complete-with-action action table string
+ (if (null pred2) pred1
+ (lexical-let ((pred1 pred2) (pred2 pred2))
+ (lambda (x)
+ ;; Call `pred1' first, so that `pred2'
+ ;; really can't tell that `x' is in table.
+ (if (funcall pred1 x) (funcall pred2 x))))))
+ ;; If completion failed and we're not applying pred1 strictly, try
+ ;; again without pred1.
+ (and (not strict)
+ (complete-with-action action table string pred2))))))
(defun completion-table-in-turn (&rest tables)
"Create a completion table that tries each table in TABLES in turn."
(complete-with-action action table string pred))
tables))))
-(defmacro complete-in-turn (a b) `(completion-table-in-turn ,a ,b))
+;; (defmacro complete-in-turn (a b) `(completion-table-in-turn ,a ,b))
+;; (defmacro dynamic-completion-table (fun) `(completion-table-dynamic ,fun))
(define-obsolete-function-alias
'complete-in-turn 'completion-table-in-turn "23.1")
+(define-obsolete-function-alias
+ 'dynamic-completion-table 'completion-table-dynamic "23.1")
;;; Minibuffer completion
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 common prefix substring for completion may be available as the
-value of `completion-common-substring'. See also `display-completion-list'.")
+The common prefix substring for completion may be available as the value
+of `completion-common-substring'. See also `display-completion-list'.")
(defun display-completion-list (completions &optional common-substring)
"Display the list of completions, COMPLETIONS, using `standard-output'.
It can find the completion buffer in `standard-output'.
The optional second arg COMMON-SUBSTRING is a string.
It is used to put faces, `completions-first-difference' and
-`completions-common-part' on the completion buffer. The
+`completions-common-part' on the completion buffer. The
`completions-common-part' face is put on the common substring
specified by COMMON-SUBSTRING. If COMMON-SUBSTRING is nil
and the current buffer is not the minibuffer, the faces are not put.
pred action))))
(defun completion--file-name-table (string dir action)
- "Internal subroutine for read-file-name. Do not call this."
+ "Internal subroutine for `read-file-name'. Do not call this."
(setq dir (expand-file-name dir))
(if (and (zerop (length string)) (eq 'lambda action))
nil ; FIXME: why?
HCoop / bpt / emacs.git / blobdiff