>> What about adding a predicate to face name completion
>> that ignores face aliases, and thus presents only
>> the proper names without the "-face" suffix?
> My thought that was it might be good to have it only complete to
> "real" names, but accept aliases if you typed them explicitly; can
> completion do this sort of thing?
There's the REQUIRE-MATCH argument to completing read.
But if you mean not just to accept but to even complete aliases (if typed
explicitly), then, yes, you can also do that:
(defmacro complete-in-turn (a b)
"Create a completion table that first tries completion in A and then in B.
A and B should not be costly (or side-effecting) expressions."
`(lambda (string predicate mode)
(cond
((eq mode t)
(or (all-completions string ,a predicate)
(all-completions string ,b predicate)))
((eq mode nil)
(or (try-completion string ,a predicate)
(try-completion string ,b predicate)))
(t
(or (test-completion string ,a predicate)
(test-completion string ,b predicate))))))
(completing-read "prompt"
(complete-in-turn <non-alias-table> <complete-table>)
...)
I'm using it right now in the interactive spec of
set-buffer-file-coding-system (see below).
Stefan
;; FIXME: provide a useful default (e.g. the one that
;; select-safe-coding-system would have chosen, or the next best one if
;; it's already the current coding system).
(interactive
(let* ((bcss (find-coding-systems-region (point-min) (point-max)))
(bcss-table (append '("dos" "unix" "mac")
(unless (equal bcss '(undecided))
(mapcar 'symbol-name
(sanitize-coding-system-list bcss)))))
(css-table
(unless (equal bcss '(undecided))
(delq nil (mapcar (lambda (cs)
(if (memq (coding-system-base cs) bcss)
(symbol-name cs)))
coding-system-list))))
(combined-table (complete-in-turn css-table coding-system-alist))
(auto-cs
(unless find-file-literally
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(set-auto-coding buffer-file-name (buffer-size))))))
(cs (completing-read (format "Coding system for saving file (default,
%s): " auto-cs)
(complete-in-turn bcss-table combined-table)
nil t nil 'coding-system-history
(if auto-cs (symbol-name auto-cs)))))
(list (unless (zerop (length cs)) (intern cs))
current-prefix-arg)))
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel
