# HG changeset patch # User Stefan Monnier # Date 1209174431 0 # Node ID add0e6cf43368a61cfb57dc0b6bf8bb8b062c767 # Parent 33d8aec6fa97a9020f533585b660ddae68261133 (completion-table-with-context): Fix `pred' for the various kinds of completion tables. (completion-emacs22-try-completion): Place cursor after the /, as was done in Emacs-22's minibuffer-complete-word. Fix bug reported by David Hansen . (completion-emacs22-try-completion): Merge all mergable text rather than /. (completion-pcm--delim-wild-regex): New var. (completion-pcm-word-delimiters): New custom. (completion-pcm--prepare-delim-re, completion-pcm--pattern-trivial-p) (completion-pcm--string->pattern, completion-pcm--pattern->regex) (completion-pcm--all-completions, completion-pcm-all-completions) (completion-pcm--merge-completions, completion-pcm--pattern->string) (completion-pcm-try-completion): New functions. (completion-styles-alist): Add them. (completion-styles): Add it to the default. diff -r 33d8aec6fa97 -r add0e6cf4336 etc/NEWS --- a/etc/NEWS Fri Apr 25 17:16:24 2008 +0000 +++ b/etc/NEWS Sat Apr 26 01:47:11 2008 +0000 @@ -65,7 +65,9 @@ * Changes in Emacs 23.1 -** `completion-auto-help' can be set to `lazy' to list the completions only +** Completion. +*** `completion-style' can be customized to choose your favorite completion. +*** `completion-auto-help' can be set to `lazy' to list the completions only if you repeat the completion. This was already supported in `partial-completion-mode'. diff -r 33d8aec6fa97 -r add0e6cf4336 lisp/ChangeLog --- a/lisp/ChangeLog Fri Apr 25 17:16:24 2008 +0000 +++ b/lisp/ChangeLog Sat Apr 26 01:47:11 2008 +0000 @@ -1,3 +1,22 @@ +2008-04-26 Stefan Monnier + + * minibuffer.el (completion-table-with-context): Fix `pred' for the + various kinds of completion tables. + (completion-emacs22-try-completion): Place cursor after the /, as was + done in Emacs-22's minibuffer-complete-word. + Fix bug reported by David Hansen . + (completion-emacs22-try-completion): Merge all mergable text rather + than just /. + (completion-pcm--delim-wild-regex): New var. + (completion-pcm-word-delimiters): New custom. + (completion-pcm--prepare-delim-re, completion-pcm--pattern-trivial-p) + (completion-pcm--string->pattern, completion-pcm--pattern->regex) + (completion-pcm--all-completions, completion-pcm-all-completions) + (completion-pcm--merge-completions, completion-pcm--pattern->string) + (completion-pcm-try-completion): New functions. + (completion-styles-alist): Add them. + (completion-styles): Add it to the default. + 2008-04-25 Nick Roberts * progmodes/gdb-ui.el (gud-watch): Don't create speedbar... diff -r 33d8aec6fa97 -r add0e6cf4336 lisp/minibuffer.el --- a/lisp/minibuffer.el Fri Apr 25 17:16:24 2008 +0000 +++ b/lisp/minibuffer.el Sat Apr 26 01:47:11 2008 +0000 @@ -114,10 +114,21 @@ ;; TODO: add `suffix' maybe? ;; Notice that `pred' is not a predicate when called from read-file-name ;; or Info-read-node-name-2. - (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)))))) + (when (functionp pred) + (setq pred + (lexical-let ((pred pred)) + ;; Predicates are called differently depending on the nature of + ;; the completion table :-( + (cond + ((vectorp table) ;Obarray. + (lambda (sym) (funcall pred (concat prefix (symbol-name sym))))) + ((hash-table-p table) + (lambda (s v) (funcall pred (concat prefix s)))) + ((functionp table) + (lambda (s) (funcall pred (concat prefix s)))) + (t ;Lists and alists. + (lambda (s) + (funcall pred (concat prefix (if (consp s) (car s) s))))))))) (let ((comp (complete-with-action action table string pred))) (cond ;; In case of try-completion, add the prefix. @@ -243,16 +254,15 @@ '((basic completion-basic-try-completion completion-basic-all-completions) (emacs22 completion-emacs22-try-completion completion-emacs22-all-completions) (emacs21 completion-emacs21-try-completion completion-emacs21-all-completions) - ;; (partial-completion - ;; completion-pcm--try-completion completion-pcm--all-completions) - ) + (partial-completion + completion-pcm-try-completion completion-pcm-all-completions)) "List of available completion styles. Each element has the form (NAME TRY-COMPLETION ALL-COMPLETIONS) where NAME is the name that should be used in `completion-styles' TRY-COMPLETION is the function that does the completion, and ALL-COMPLETIONS is the function that lists the completions.") -(defcustom completion-styles '(basic) +(defcustom completion-styles '(basic partial-completion) "List of completion styles to use." :type `(repeat (choice ,@(mapcar (lambda (x) (list 'const (car x))) completion-styles-alist))) @@ -1002,20 +1012,216 @@ ;; Merge a trailing / in completion with a / after point. ;; We used to only do it for word completion, but it seems to make ;; sense for all completions. - (if (and (eq ?/ (aref completion (1- (length completion)))) + ;; Actually, claiming this feature was part of Emacs-22 completion + ;; is pushing it a bit: it was only done in minibuffer-completion-word, + ;; which was (by default) not bound during file completion, where such + ;; slashes are most likely to occur. + (if (and (not (zerop (length completion))) + (eq ?/ (aref completion (1- (length completion)))) (not (zerop (length suffix))) (eq ?/ (aref suffix 0))) - ;; This leaves point before the / . - ;; Should we maybe put it after the / ? --Stef - (setq completion (substring completion 0 -1))) + ;; This leaves point after the / . + (setq suffix (substring suffix 1))) (cons (concat completion suffix) (length completion))))) (defun completion-emacs22-all-completions (string table pred point) (all-completions (substring string 0 point) table pred t)) -(defalias 'completion-basic-try-completion 'completion-emacs22-try-completion) +(defun completion-basic-try-completion (string table pred point) + (let ((suffix (substring string point)) + (completion (try-completion (substring string 0 point) table pred))) + (if (not (stringp completion)) + completion + ;; Merge end of completion with beginning of suffix. + ;; Simple generalization of the "merge trailing /" done in Emacs-22. + (when (and (not (zerop (length suffix))) + (string-match "\\(.+\\)\n\\1" (concat completion "\n" suffix) + ;; Make sure we don't compress things to less + ;; than we started with. + point) + ;; Just make sure we didn't match some other \n. + (eq (match-end 1) (length completion))) + (setq suffix (substring suffix (- (match-end 1) (match-beginning 1))))) + + (cons (concat completion suffix) (length completion))))) + (defalias 'completion-basic-all-completions 'completion-emacs22-all-completions) +;;; Partial-completion-mode style completion. + +;; BUGS: + +;; - "minibuffer-s- TAB" with minibuffer-selected-window ends up with +;; "minibuffer--s-" which matches other options. + +(defvar completion-pcm--delim-wild-regex nil) + +(defun completion-pcm--prepare-delim-re (delims) + (setq completion-pcm--delim-wild-regex (concat "[" delims "*]"))) + +(defcustom completion-pcm-word-delimiters "-_. " + "A string of characters treated as word delimiters for completion. +Some arcane rules: +If `]' is in this string, it must come first. +If `^' is in this string, it must not come first. +If `-' is in this string, it must come first or right after `]'. +In other words, if S is this string, then `[S]' must be a valid Emacs regular +expression (not containing character ranges like `a-z')." + :set (lambda (symbol value) + (set-default symbol value) + ;; Refresh other vars. + (completion-pcm--prepare-delim-re value)) + :initialize 'custom-initialize-reset + :type 'string) + +(defun completion-pcm--pattern-trivial-p (pattern) + (and (stringp (car pattern)) (null (cdr pattern)))) + +(defun completion-pcm--string->pattern (basestr &optional point) + "Split BASESTR into a pattern. +A pattern is a list where each element is either a string +or a symbol chosen among `any', `star', `point'." + (if (and point (< point (length basestr))) + (let ((prefix (substring basestr 0 point)) + (suffix (substring basestr point))) + (append (completion-pcm--string->pattern prefix) + '(point) + (completion-pcm--string->pattern suffix))) + (let ((pattern nil) + (p 0) + (p0 0)) + + (while (setq p (string-match completion-pcm--delim-wild-regex basestr p)) + (push (substring basestr p0 p) pattern) + (if (eq (aref basestr p) ?*) + (progn + (push 'star pattern) + (setq p0 (1+ p))) + (push 'any pattern) + (setq p0 p)) + (incf p)) + + ;; An empty string might be erroneously added at the beginning. + ;; It should be avoided properly, but it's so easy to remove it here. + (delete "" (nreverse (cons (substring basestr p0) pattern)))))) + +(defun completion-pcm--pattern->regex (pattern &optional group) + (concat "\\`" + (mapconcat + (lambda (x) + (case x + ((star any point) (if group "\\(.*?\\)" ".*?")) + (t (regexp-quote x)))) + pattern + ""))) + +(defun completion-pcm--all-completions (pattern table pred) + "Find all completions for PATTERN in TABLE obeying PRED. +PATTERN is as returned by `complete-string->pattern'." + ;; Find an initial list of possible completions. + (if (completion-pcm--pattern-trivial-p pattern) + + ;; Minibuffer contains no delimiters -- simple case! + (all-completions (car pattern) table pred) + + ;; Use all-completions to do an initial cull. This is a big win, + ;; since all-completions is written in C! + (let* (;; Convert search pattern to a standard regular expression. + (regex (completion-pcm--pattern->regex pattern)) + (completion-regexp-list (cons regex completion-regexp-list)) + (compl (all-completions + (if (stringp (car pattern)) (car pattern)) + table pred)) + (last (last compl))) + ;; FIXME: If `base-size' is not 0, we have a problem :-( + (if last (setcdr last nil)) + (if (not (functionp table)) + ;; The internal functions already obeyed completion-regexp-list. + compl + (let ((case-fold-search completion-ignore-case) + (poss ())) + (dolist (c compl) + (when (string-match regex c) (push c poss))) + poss))))) + +(defun completion-pcm-all-completions (string table pred point) + (let ((pattern (completion-pcm--string->pattern string point))) + (completion-pcm--all-completions pattern table pred))) + +(defun completion-pcm--merge-completions (strs pattern) + "Extract the commonality in STRS, with the help of PATTERN." + (cond + ((null (cdr strs)) (list (car strs))) + (t + (let ((re (completion-pcm--pattern->regex pattern 'group)) + (ccs ())) ;Chopped completions. + + ;; First chop each string into the parts corresponding to each + ;; non-constant element of `pattern', using regexp-matching. + (let ((case-fold-search completion-ignore-case)) + (dolist (str strs) + (unless (string-match re str) + (error "Internal error: %s doesn't match %s" str re)) + (let ((chopped ()) + (i 1)) + (while (match-beginning i) + (push (match-string i str) chopped) + (setq i (1+ i))) + ;; Add the text corresponding to the implicit trailing `any'. + (push (substring str (match-end 0)) chopped) + (push (nreverse chopped) ccs)))) + + ;; Then for each of those non-constant elements, extract the + ;; commonality between them. + (let ((res ())) + ;; Make the implicit `any' explicit. We could make it explicit + ;; everywhere, but it would slow down regexp-matching a little bit. + (dolist (elem (append pattern '(any))) + (if (stringp elem) + (push elem res) + (let ((comps ())) + (dolist (cc (prog1 ccs (setq ccs nil))) + (push (car cc) comps) + (push (cdr cc) ccs)) + (let* ((prefix (try-completion "" comps)) + (unique (or (and (eq prefix t) (setq prefix "")) + (eq t (try-completion prefix comps))))) + (unless (equal prefix "") (push prefix res)) + ;; If there's only one completion, `elem' is not useful + ;; any more: it can only match the empty string. + ;; FIXME: in some cases, it may be necessary to turn an + ;; `any' into a `star' because the surrounding context has + ;; changed such that string->pattern wouldn't add an `any' + ;; here any more. + (unless unique (push elem res)))))) + ;; We return it in reverse order. + res))))) + +(defun completion-pcm--pattern->string (pattern) + (mapconcat (lambda (x) (cond + ((stringp x) x) + ((eq x 'star) "*") + ((eq x 'any) "") + ((eq x 'point) ""))) + pattern + "")) + +(defun completion-pcm-try-completion (string table pred point) + (let* ((pattern (completion-pcm--string->pattern string point)) + (all (completion-pcm--all-completions pattern table pred))) + (when all + (let* ((mergedpat (completion-pcm--merge-completions all pattern)) + ;; `mergedpat' is in reverse order. + (pointpat (or (memq 'point mergedpat) (memq 'any mergedpat))) + ;; New pos from the end. + (newpos (length (completion-pcm--pattern->string pointpat))) + ;; Do it afterwards because it changes `pointpat' by sideeffect. + (merged (completion-pcm--pattern->string (nreverse mergedpat)))) + (cons merged (- (length merged) newpos)))))) + + + + (provide 'minibuffer) ;; arch-tag: ef8a0a15-1080-4790-a754-04017c02f08f