Re: Completion of face names

[Stefan Monnier]

>> 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)))