[Emacs-diffs] emacs etc/NEWS lisp/ChangeLog lisp/minibuffer.el

[Stefan Monnier]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Stefan Monnier <monnier>        09/09/01 19:49:47

Modified files:
        etc            : NEWS 
        lisp           : ChangeLog minibuffer.el 

Log message:
        (completion-try-completion, completion-all-completions):
        Remove ill-defined (and mistakenly installed and luckily never used nor
        documented) `completion-styles' property.
        (completion-initials-expand, completion-initials-all-completions)
        (completion-initials-try-completion): New functions.
        (completion-styles-alist): Add doc to each entry.
        Add new `initials' entry.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/etc/NEWS?cvsroot=emacs&r1=1.2073&r2=1.2074
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.16082&r2=1.16083
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/minibuffer.el?cvsroot=emacs&r1=1.80&r2=1.81

Patches:
Index: etc/NEWS
===================================================================
RCS file: /sources/emacs/emacs/etc/NEWS,v
retrieving revision 1.2073
retrieving revision 1.2074
diff -u -b -r1.2073 -r1.2074
--- etc/NEWS    1 Sep 2009 02:54:49 -0000       1.2073
+++ etc/NEWS    1 Sep 2009 19:49:34 -0000       1.2074
@@ -34,6 +34,8 @@
 
 * Changes in Emacs 23.2
 
+** New completion-style `initials' to complete M-x lch to list-command-history.
+
 ** Unibyte sessions are declared obsolete.
 I.e. the use of the environment variable EMACS_UNIBYTE, or command line
 arguments --unibyte, --multibyte, --no-multibyte, and --no-unibyte

Index: lisp/ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.16082
retrieving revision 1.16083
diff -u -b -r1.16082 -r1.16083
--- lisp/ChangeLog      1 Sep 2009 16:26:23 -0000       1.16082
+++ lisp/ChangeLog      1 Sep 2009 19:49:39 -0000       1.16083
@@ -1,3 +1,14 @@
+2009-09-01  Stefan Monnier  <address@hidden>
+
+       * minibuffer.el (completion-try-completion)
+       (completion-all-completions): Remove ill-defined (and
+       mistakenly installed and luckily never used nor documented)
+       `completion-styles' property.
+       (completion-initials-expand, completion-initials-all-completions)
+       (completion-initials-try-completion): New functions.
+       (completion-styles-alist): Add doc to each entry.
+       Add new `initials' entry.
+
 2009-09-01  Nick Roberts  <address@hidden>
 
        * progmodes/gdb-mi.el (gdb-var-create-handler): Remove redundant

Index: lisp/minibuffer.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/minibuffer.el,v
retrieving revision 1.80
retrieving revision 1.81
diff -u -b -r1.80 -r1.81
--- lisp/minibuffer.el  30 Aug 2009 03:45:33 -0000      1.80
+++ lisp/minibuffer.el  1 Sep 2009 19:49:46 -0000       1.81
@@ -315,16 +315,33 @@
   :group 'minibuffer)
 
 (defvar completion-styles-alist
-  '((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)
+  '((emacs21
+     completion-emacs21-try-completion completion-emacs21-all-completions
+     "Simple prefix-based completion.")
+    (emacs22
+     completion-emacs22-try-completion completion-emacs22-all-completions
+     "Prefix completion that only operates on the text before point.")
+    (basic
+     completion-basic-try-completion completion-basic-all-completions
+     "Completion of the prefix before point and the suffix after point.")
     (partial-completion
-     completion-pcm-try-completion completion-pcm-all-completions))
+     completion-pcm-try-completion completion-pcm-all-completions
+     "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.")
+    (initials
+     completion-initials-try-completion completion-initials-all-completions
+     "Completion of acronyms and initialisms.
+E.g. can complete M-x lch to list-command-history
+and C-x C-f ~/sew to ~/src/emacs/work."))
   "List of available completion styles.
-Each element has the form (NAME TRY-COMPLETION ALL-COMPLETIONS)
+Each element has the form (NAME TRY-COMPLETION ALL-COMPLETIONS DOC):
 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.")
+TRY-COMPLETION is the function that does the completion (it should
+follow the same calling convention as `completion-try-completion'),
+ALL-COMPLETIONS is the function that lists the completions (it should
+follow the calling convention of `completion-all-completions'),
+and DOC describes the way this style of completion works.")
 
 (defcustom completion-styles '(basic partial-completion emacs22)
   "List of completion styles to use.
@@ -342,19 +359,10 @@
 t to indicate that STRING is the only possible completion,
 or a pair (STRING . NEWPOINT) of the completed result string together with
 a new position for point."
-  ;; The property `completion-styles' indicates that this functional
-  ;; completion-table claims to take care of completion styles itself.
-  ;; [I.e. It will most likely call us back at some point. ]
-  (if (and (symbolp table) (get table 'completion-styles))
-      ;; Extended semantics for functional completion-tables:
-      ;; They accept a 4th argument `point' and when called with action=nil
-      ;; and this 4th argument (a position inside `string'), they should
-      ;; return instead of a string a pair (STRING . NEWPOINT).
-      (funcall table string pred nil point)
     (completion--some (lambda (style)
                         (funcall (nth 1 (assq style completion-styles-alist))
                                  string table pred point))
-                      completion-styles)))
+                    completion-styles))
 
 (defun completion-all-completions (string table pred point)
   "List the possible completions of STRING in completion table TABLE.
@@ -364,19 +372,10 @@
 in the last `cdr'."
   ;; FIXME: We need to additionally return completion-extra-size (similar
   ;; to completion-base-size but for the text after point).
-  ;; The property `completion-styles' indicates that this functional
-  ;; completion-table claims to take care of completion styles itself.
-  ;; [I.e. It will most likely call us back at some point. ]
-  (if (and (symbolp table) (get table 'completion-styles))
-      ;; Extended semantics for functional completion-tables:
-      ;; They accept a 4th argument `point' and when called with action=t
-      ;; and this 4th argument (a position inside `string'), they may
-      ;; return BASE-SIZE in the last `cdr'.
-      (funcall table string pred t point)
     (completion--some (lambda (style)
                         (funcall (nth 2 (assq style completion-styles-alist))
                                  string table pred point))
-                      completion-styles)))
+                    completion-styles))
 
 (defun minibuffer--bitset (modified completions exact)
   (logior (if modified    4 0)
@@ -1769,6 +1768,44 @@
            'completion-pcm--filename-try-filter))
     (completion-pcm--merge-try pattern all prefix suffix)))
 
+;;; Initials completion
+;; Complete /ums to /usr/monnier/src or lch to list-command-history.
+
+(defun completion-initials-expand (str table pred)
+  (unless (or (zerop (length str))
+              (string-match completion-pcm--delim-wild-regex string))
+    (let ((bounds (completion-boundaries str table pred "")))
+      (if (zerop (car bounds))
+          (mapconcat 'string str "-")
+        ;; If there's a boundary, it's trickier.  The main use-case
+        ;; we consider here is file-name completion.  We'd like
+        ;; to expand ~/eee to ~/e/e/e and /eee to /e/e/e.
+        ;; But at the same time, we don't want /usr/share/ae to expand
+        ;; to /usr/share/a/e just because we mistyped "ae" for "ar",
+        ;; so we probably don't want initials to touch anything that
+        ;; looks like /usr/share/foo.  As a heuristic, we just check that
+        ;; the text before the boundary char is at most 1 char.
+        ;; This allows both ~/eee and /eee and not much more.
+        ;; FIXME: It sadly also disallows the use of ~/eee when that's
+        ;; embedded within something else (e.g. "(~/eee" in Info node
+        ;; completion or "ancestor:/eee" in bzr-revision completion).
+        (when (< (car bounds) 3)
+          (let ((sep (substring str (1- (car bounds)) (car bounds))))
+            ;; FIXME: the above string-match checks the whole string, whereas
+            ;; we end up only caring about the after-boundary part.
+            (concat (substring str 0 (car bounds))
+                    (mapconcat 'string (substring str (car bounds)) sep))))))))
+
+(defun completion-initials-all-completions (string table pred point)
+  (let ((newstr (completion-initials-expand string table pred)))
+    (when newstr
+      (completion-pcm-all-completions newstr table pred (length newstr)))))
+
+(defun completion-initials-try-completion (string table pred point)
+  (let ((newstr (completion-initials-expand string table pred)))
+    (when newstr
+      (completion-pcm-try-completion newstr table pred (length newstr)))))
+
 
 (provide 'minibuffer)