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 317f5cedf24f9b8af8e26d480471963b718514ae..ce3ba7cf153d0ebd44646eb0566cb39bc4b3ce70 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -94,6 +94,8 @@ Secret Service API requires D-Bus for communication.
 \f
 * 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 afce3835ed2dccbad221e03957bb548a75eea8a5..cf6b4d3496ff3f325d82b553c8327ec9825608e2 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2010-03-23  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       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  <monnier@iro.umontreal.ca>
 
        Get rid of .elc files after removal of the corresponding .el.

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 54d155cd510b22fab0c13ff47210177ad2abb053..94effe5799497b7329b35fd6c6d45e842b334169 100644 (file)
--- 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)