emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

extending icomplete -- help?


From: Alex Schroeder
Subject: extending icomplete -- help?
Date: Fri, 05 Apr 2002 12:10:10 +0200
User-agent: Gnus/5.090006 (Oort Gnus v0.06) Emacs/21.2 (i686-pc-linux-gnu)

I'm trying to modify icomplete such as to allow the typing of
arbitrary substrings for completion, not just beginnings of words.  At
the current stage I need some more help from people that understand
minibuffers better than I do.

Here is what I currently have -- activate icomplete-mode, override
icomplete-completions, and a new function to replace all-completions
and which uses a cache, plus some testing stuff as you can see.

Anybody feel like helping out?

Kevin Burton wrote something similar called irepeat.el, which is more
or less a replacement for completing-read + some example functions
using it.  Using icomplete.el would allow us to use this for all
minibuffers.  I think this is the direction RMS suggested when he saw
irepeat.el.

The current code looks nice (I guess adding hilighting a la
iswitch-buffer would be easy), but it has some quirks such as handling
TAB to complete when there is only one completion left.

Alex.

(icomplete-mode)

(when nil
  (setq ob [alex otto friedolin berta michi])
  (icomplete-find-matches "e" ob nil)
  (icomplete-find-matches "ex" ob nil)
  (icomplete-find-matches "lex" ob nil)
  (setq al '(("foo") ("bar") ("baz")))
  (icomplete-find-matches "b" al nil)
  (icomplete-find-matches "ba" al nil)
  (icomplete-find-matches "bar" al nil)
)

(defvar icomplete-original-completions nil)
(defvar icomplete-last-str nil)
(defvar icomplete-pruned-completions nil)
(defvar icomplete-pruned-remainders nil)

(defun icomplete-find-matches (str completions predicate)
  "Find all entries in COMPLETIONS matching STR.
If PREDICATE is non-nil, the entries must also satisfy it.
COMPLETIONS can be an alist, in which case the car of all
entries is used, or an obarray, ie. a vector of symbols.
PREDICATE must be a function accepting an alist entry or
a symbol, depending on COMPLETIONS. This function also does
caching in order to optimize for repeated calls.  The return
value is a list (STR2 LIST) where STR2 is the longest
common substring, and LIST is the list of completions matching
it."
  ;; Check for three special cases: no completions, which in
  ;; minibuffers may also look like (nil), obarrays, which are
  ;; certainly not cached, and lists, which are potentially cached.
  (cond ((or (null completions)
             (and (listp completions)
                  (null (car completions))))
         ;; (message "No completions")
         ;; (sit-for 1)
         (setq icomplete-pruned-completions nil))
        ;; if the cache can be used, the predicate has been applied
        ;; already and the pruned list contains only strings
        ((and (eq completions icomplete-original-completions)
              (string-match icomplete-last-str str))
         ;; (message "Using the cache (%d)"
         ;;       (length icomplete-pruned-completions))
         ;; (sit-for 1)
         (setq completions icomplete-pruned-completions)
         (let (result remainders)
           (dolist (item completions)
             (when (string-match str item)
               (setq result (cons item result)
                     remainders (cons (substring item (match-end 0))
                                      remainders))))
           (setq icomplete-last-str str
                 icomplete-pruned-remainders remainders
                 icomplete-pruned-completions (nreverse result))))
        ;; a new obarray
        ((vectorp completions)
         ;; (message "Initializing cache with obarray [%d]"
         ;;       (length completions))
         ;; (sit-for 1)
         (let (item result remainders)
           (if predicate
               (dotimes (i (length completions))
                 (setq item (symbol-name (aref completions i)))
                 (when (and (funcall predicate item)
                            (string-match str item))
                   (setq result (cons item result)
                         remainders (cons (substring item (match-end 0))
                                          remainders))))
             (dotimes (i (length completions))
               (setq item (symbol-name (aref completions i)))
               (when (string-match str item)
                 (setq result (cons item result)
                       remainders (cons (substring item (match-end 0))
                                        remainders)))))
           (setq icomplete-original-completions completions
                 icomplete-last-str str
                 icomplete-pruned-remainders remainders
                 icomplete-pruned-completions (nreverse result))))
        ;; new alist
        ((and (listp completions) (listp (car completions)))
         ;; (message "Initializing cache with alist ((%d))"
         ;;       (length completions))
         ;; (sit-for 1)
         (let (result remainders)
           (if predicate
               (dolist (item completions)
                 (when (and (funcall predicate item)
                            (string-match str (car item)))
                   (setq result (cons (car item) result)
                         remainders (cons (substring (car item) (match-end 0))
                                          remainders))))
             (dolist (item completions)
               (when (string-match str (car item))
                 (setq result (cons (car item) result)
                       remainders (cons (substring (car item) (match-end 0))
                                        remainders)))))
           (setq icomplete-original-completions completions
                 icomplete-last-str str
                 icomplete-pruned-remainders remainders
                 icomplete-pruned-completions (nreverse result))))
        (t
         (error "Completions type not supported: %s"
                (type-of completions))))
  ;; return value
  (cond ((null icomplete-pruned-remainders); none
         (list icomplete-last-str nil))
        ((not (cdr icomplete-pruned-remainders)); one
         (list (concat icomplete-last-str
                       (car icomplete-pruned-remainders))
               icomplete-pruned-completions))
        (t
         (let ((match (try-completion
                       "" (mapcar 'list icomplete-pruned-remainders))))
           (when (eq match t)
             (error "try-completion returned t"))
           (list (concat icomplete-last-str
                         match)
                 icomplete-pruned-completions)))))

(defun icomplete-completions (name candidates predicate require-match)
  "..."
  (interactive)
  (let* ((matches (icomplete-find-matches name candidates predicate))
         (longest-match (nth 0 matches))
         (comps (nth 1 matches))
         (open-bracket-determined (if require-match "(" "["))
         (close-bracket-determined (if require-match ")" "]"))
         answer)
    (cond ((null comps); no matches
           (setq answer
                 (concat " " open-bracket-determined
                         "No matches" close-bracket-determined)))
          ((not (cdr comps)); only one match
           (setq answer
                 (concat open-bracket-determined
                         (car comps)
                         close-bracket-determined
                         " [Matched]")))
           (t
            ;; if the longest match is longer than the current name,
            ;; show it as the "determined" part
            (when (> (length longest-match) (length name))
              (setq answer (concat open-bracket-determined
                                   longest-match
                                   close-bracket-determined)))
           ;; truncate the list of prospects, then format them
           (let ((pair (nthcdr icomplete-prospects-length comps)))
             (when pair
               (setcdr pair nil))
             ;; add space, if answer already has a determined part
             (setq answer (if answer (concat answer " ") ""))
             (setq answer (concat answer
                                  "{"
                                  (mapconcat 'identity comps ",")
                                  (if pair
                                      ",..."
                                    "")
                                  "}")))))
    answer))

(when nil
  (setq ob [alex otto friedolin berta michi])
  (icomplete-find-matches "e" ob nil)
  (icomplete-completions "e" ob nil nil)
  (icomplete-find-matches "ex" ob nil)
  (icomplete-completions "ex" ob nil nil)
  (icomplete-completions "lex" ob nil nil)
  (setq al '(("foo") ("bar") ("baz")))
  (icomplete-find-matches "b" al nil)
  (icomplete-completions "b" al nil nil)
  (icomplete-find-matches "ba" al nil)
  (icomplete-find-matches "bar" al nil)
)




reply via email to

[Prev in Thread] Current Thread [Next in Thread]