From: Stefan Monnier Date: Tue, 23 Mar 2010 00:59:49 +0000 (-0400) Subject: Add a new completion style `substring'. X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~438^2~685 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=002787475ff69f44a4fbd26bfe8b8dad3ea435ed;p=emacs.git Add a new completion style `substring'. * minibuffer.el (completion-basic--pattern): New function. (completion-basic-try-completion, completion-basic-all-completions): Use it. (completion-substring--all-completions) (completion-substring-try-completion) (completion-substring-all-completions): New functions. (completion-styles-alist): New style `substring'. --- diff --git a/etc/NEWS b/etc/NEWS index 317f5cedf24..ce3ba7cf153 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -94,6 +94,8 @@ Secret Service API requires D-Bus for communication. * Lisp changes in Emacs 24.1 +** New completion style `substring'. + ** Image API *** When the image type is one of listed in `image-animated-types' diff --git a/lisp/ChangeLog b/lisp/ChangeLog index afce3835ed2..cf6b4d3496f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2010-03-23 Stefan Monnier + + Add a new completion style `substring'. + * minibuffer.el (completion-basic--pattern): New function. + (completion-basic-try-completion, completion-basic-all-completions): + Use it. + (completion-substring--all-completions) + (completion-substring-try-completion) + (completion-substring-all-completions): New functions. + (completion-styles-alist): New style `substring'. + 2010-03-22 Stefan Monnier Get rid of .elc files after removal of the corresponding .el. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 54d155cd510..94effe57994 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -393,6 +393,9 @@ the second failed attempt to complete." "Completion of multiple words, each one taken as a prefix. E.g. M-x l-c-h can complete to list-command-history and C-x C-f /u/m/s to /usr/monnier/src.") + (substring + completion-substring-try-completion completion-substring-all-completions + "Completion of the string taken as a substring.") (initials completion-initials-try-completion completion-initials-all-completions "Completion of acronyms and initialisms. @@ -1658,6 +1661,12 @@ Return the new suffix." ;; Nothing to merge. suffix)) +(defun completion-basic--pattern (beforepoint afterpoint bounds) + (delete + "" (list (substring beforepoint (car bounds)) + 'point + (substring afterpoint 0 (cdr bounds))))) + (defun completion-basic-try-completion (string table pred point) (let* ((beforepoint (substring string 0 point)) (afterpoint (substring string point)) @@ -1674,10 +1683,8 @@ Return the new suffix." (length completion)))) (let* ((suffix (substring afterpoint (cdr bounds))) (prefix (substring beforepoint 0 (car bounds))) - (pattern (delete - "" (list (substring beforepoint (car bounds)) - 'point - (substring afterpoint 0 (cdr bounds))))) + (pattern (completion-basic--pattern + beforepoint afterpoint bounds)) (all (completion-pcm--all-completions prefix pattern table pred))) (if minibuffer-completing-file-name (setq all (completion-pcm--filename-try-filter all))) @@ -1687,12 +1694,8 @@ Return the new suffix." (let* ((beforepoint (substring string 0 point)) (afterpoint (substring string point)) (bounds (completion-boundaries beforepoint table pred afterpoint)) - (suffix (substring afterpoint (cdr bounds))) (prefix (substring beforepoint 0 (car bounds))) - (pattern (delete - "" (list (substring beforepoint (car bounds)) - 'point - (substring afterpoint 0 (cdr bounds))))) + (pattern (completion-basic--pattern beforepoint afterpoint bounds)) (all (completion-pcm--all-completions prefix pattern table pred))) (completion-hilit-commonality all point (car bounds)))) @@ -2069,7 +2072,38 @@ filter out additional entries (because TABLE migth not obey PRED)." 'completion-pcm--filename-try-filter)) (completion-pcm--merge-try pattern all prefix suffix))) -;;; Initials completion +;;; Substring completion +;; Mostly derived from the code of `basic' completion. + +(defun completion-substring--all-completions (string table pred point) + (let* ((beforepoint (substring string 0 point)) + (afterpoint (substring string point)) + (bounds (completion-boundaries beforepoint table pred afterpoint)) + (suffix (substring afterpoint (cdr bounds))) + (prefix (substring beforepoint 0 (car bounds))) + (basic-pattern (completion-basic--pattern + beforepoint afterpoint bounds)) + (pattern (if (not (stringp (car basic-pattern))) + basic-pattern + (cons 'any basic-pattern))) + (all (completion-pcm--all-completions prefix pattern table pred))) + (list all pattern prefix suffix (car bounds)))) + +(defun completion-substring-try-completion (string table pred point) + (destructuring-bind (all pattern prefix suffix carbounds) + (completion-substring--all-completions string table pred point) + (if minibuffer-completing-file-name + (setq all (completion-pcm--filename-try-filter all))) + (completion-pcm--merge-try pattern all prefix suffix))) + +(defun completion-substring-all-completions (string table pred point) + (destructuring-bind (all pattern prefix suffix carbounds) + (completion-substring--all-completions string table pred point) + (when all + (nconc (completion-pcm--hilit-commonality pattern all) + (length prefix))))) + +;; Initials completion ;; Complete /ums to /usr/monnier/src or lch to list-command-history. (defun completion-initials-expand (str table pred)