diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 384a30cb7cd..8f96a838cc5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2011-05-31 Stefan Monnier + + * minibuffer.el (complete-with-action): Return nil for the metadata and + boundaries of non-functional tables. + (completion-table-dynamic): Return nil for the metadata. + (completion-table-with-terminator): Add default case, using + complete-with-action. + (completion--metadata): New function. + (completion-all-sorted-completions, minibuffer-completion-help): Use it + to try and avoid pathological performance problems. + (completion--embedded-envvar-table): Return `category' metadata. + 2011-05-31 Lars Magne Ingebrigtsen * subr.el (process-alive-p): New tiny convenience function. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 0f96f7905eb..972c65f62e3 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -26,11 +26,15 @@ ;; internal use only. ;; Functional completion tables have an extended calling conventions: -;; - The `action' can be (additionally to nil, t, and lambda) of the form -;; (boundaries . SUFFIX) in which case it should return +;; 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'. ;; Any other return value should be ignored (so we ignore values returned ;; from completion tables that don't know about this new `action' form). +;; - `metadata' in which case it should return (metadata . ALIST) where +;; ALIST is the metadata of this table. See `completion-metadata'. +;; Any other return value should be ignored (so we ignore values returned +;; from completion tables that don't know about this new `action' form). ;;; Bugs: @@ -107,7 +111,8 @@ E.g. for simple completion tables, the result is always (0 . (length SUFFIX)) and for file names the result is the positions delimited by the closest directory separators." (let ((boundaries (if (functionp table) - (funcall table string pred (cons 'boundaries suffix))))) + (funcall table string pred + (cons 'boundaries suffix))))) (if (not (eq (car-safe boundaries) 'boundaries)) (setq boundaries nil)) (cons (or (cadr boundaries) 0) @@ -125,7 +130,8 @@ This metadata is an alist. Currently understood keys are: Takes one argument (COMPLETIONS) and should return a new list of completions. Can operate destructively. - `cycle-sort-function': function to sort entries when cycling. - Works like `display-sort-function'." + Works like `display-sort-function'. +The metadata of a completion table should be constant between two boundaries." (let ((metadata (if (functionp table) (funcall table string pred 'metadata)))) (if (eq (car-safe metadata) 'metadata) @@ -160,8 +166,8 @@ PRED is a completion predicate. ACTION can be one of nil, t or `lambda'." (cond ((functionp table) (funcall table string pred action)) - ((eq (car-safe action) 'boundaries) - (cons 'boundaries (completion-boundaries string table pred (cdr action)))) + ((eq (car-safe action) 'boundaries) nil) + ((eq action 'metadata) nil) (t (funcall (cond @@ -182,7 +188,7 @@ The result of the `completion-table-dynamic' form is a function that can be used as the COLLECTION argument to `try-completion' and `all-completions'. See Info node `(elisp)Programmed Completion'." (lambda (string pred action) - (if (eq (car-safe action) 'boundaries) + (if (or (eq (car-safe action) 'boundaries) (eq action 'metadata)) ;; `fun' is not supposed to return another function but a plain old ;; completion table, whose boundaries are always trivial. nil @@ -287,18 +293,18 @@ instead of a string, a function that takes the completion and returns the (funcall terminator comp) (concat comp terminator)) comp)))) - ((eq action t) + ;; 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) + (t ;; FIXME: We generally want the `try' and `all' behaviors to be ;; 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*. ;; (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, - ;; in which case `test-completion' should return nil. - ((eq action 'lambda) nil))) + (complete-with-action action table string pred)))) (defun completion-table-with-predicate (table pred1 strict string pred2 action) "Make a completion table equivalent to TABLE but filtered through PRED1. @@ -769,22 +775,33 @@ scroll the window of possible completions." (setq completion-cycling nil) (setq completion-all-sorted-completions nil)) +(defun completion--metadata (string base md-at-point table pred) + ;; Like completion-metadata, but for the specific case of getting the + ;; metadata at `base', which tends to trigger pathological behavior for old + ;; completion tables which don't understand `metadata'. + (let ((bounds (completion-boundaries string table pred ""))) + (if (eq (car bounds) base) md-at-point + (completion-metadata (substring string 0 base) table pred)))) + (defun completion-all-sorted-completions () (or completion-all-sorted-completions (let* ((start (field-beginning)) (end (field-end)) (string (buffer-substring start end)) + (md (completion--field-metadata start)) (all (completion-all-completions string minibuffer-completion-table minibuffer-completion-predicate (- (point) start) - (completion--field-metadata start))) + md)) (last (last all)) (base-size (or (cdr last) 0)) - (all-md (completion-metadata (substring string 0 base-size) - minibuffer-completion-table - minibuffer-completion-predicate)) + (all-md (completion--metadata (buffer-substring-no-properties + start (point)) + base-size md + minibuffer-completion-table + minibuffer-completion-predicate)) (sort-fun (completion-metadata-get all-md 'cycle-sort-function))) (when last (setcdr last nil) @@ -1272,12 +1289,13 @@ variables.") (let* ((start (field-beginning)) (end (field-end)) (string (field-string)) + (md (completion--field-metadata start)) (completions (completion-all-completions string minibuffer-completion-table minibuffer-completion-predicate (- (point) (field-beginning)) - (completion--field-metadata start)))) + md))) (message nil) (if (or (null completions) (and (not (consp (cdr completions))) @@ -1293,12 +1311,11 @@ variables.") (let* ((last (last completions)) (base-size (cdr last)) (prefix (unless (zerop base-size) (substring string 0 base-size))) - ;; FIXME: This function is for the output of all-completions, - ;; not completion-all-completions. Often it's the same, but - ;; not always. - (all-md (completion-metadata (substring string 0 base-size) - minibuffer-completion-table - minibuffer-completion-predicate)) + (all-md (completion--metadata (buffer-substring-no-properties + start (point)) + base-size md + minibuffer-completion-table + minibuffer-completion-predicate)) (afun (or (completion-metadata-get all-md 'annotation-function) (plist-get completion-extra-properties :annotation-function) @@ -1673,8 +1690,8 @@ same as `substitute-in-file-name'." ;; other table that provides the "main" completion. Let the ;; other table handle the test-completion case. nil) - ((eq (car-safe action) 'boundaries) - ;; Only return boundaries if there's something to complete, + ((or (eq (car-safe action) 'boundaries) (eq action 'metadata)) + ;; Only return boundaries/metadata if there's something to complete, ;; since otherwise when we're used in ;; completion-table-in-turn, we could return boundaries and ;; let some subsequent table return a list of completions. @@ -1684,11 +1701,13 @@ same as `substitute-in-file-name'." (when (try-completion (substring string beg) table nil) ;; Compute the boundaries of the subfield to which this ;; completion applies. - (let ((suffix (cdr action))) - (list* 'boundaries - (or (match-beginning 2) (match-beginning 1)) - (when (string-match "[^[:alnum:]_]" suffix) - (match-beginning 0)))))) + (if (eq action 'metadata) + '(metadata (category . environment-variable)) + (let ((suffix (cdr action))) + (list* 'boundaries + (or (match-beginning 2) (match-beginning 1)) + (when (string-match "[^[:alnum:]_]" suffix) + (match-beginning 0))))))) (t (if (eq (aref string (1- beg)) ?{) (setq table (apply-partially 'completion-table-with-terminator @@ -2299,7 +2318,8 @@ PATTERN is as returned by `completion-pcm--string->pattern'." (case-fold-search completion-ignore-case) (completion-regexp-list (cons regex completion-regexp-list)) (compl (all-completions - (concat prefix (if (stringp (car pattern)) (car pattern) "")) + (concat prefix + (if (stringp (car pattern)) (car pattern) "")) table pred))) (if (not (functionp table)) ;; The internal functions already obeyed completion-regexp-list. @@ -2397,13 +2417,14 @@ filter out additional entries (because TABLE migth not obey PRED)." (- (length newbeforepoint) (car newbounds))))) (dolist (submatch suball) - (setq all (nconc (mapcar - (lambda (s) (concat submatch between s)) - (funcall filter - (completion-pcm--all-completions - (concat subprefix submatch between) - pattern table pred))) - all))) + (setq all (nconc + (mapcar + (lambda (s) (concat submatch between s)) + (funcall filter + (completion-pcm--all-completions + (concat subprefix submatch between) + pattern table pred))) + all))) ;; FIXME: This can come in handy for try-completion, ;; but isn't right for all-completions, since it lists ;; invalid completions.