Re: after-21.1-xmail (bugs with current CVS (was: buglets :-))

[Jason Rumney]

Werner LEMBERG <address@hidden> writes:

> . Using the direct route with the menus, I finally reach the
>   customizing location for tooltips.  Selecting the button for `Font
>   Family', I try to select `Family', expecting a list of available
>   families.  But I don't get one.  Apparently I have to guess a
>   family.  Well, I know some, but Joe User?  I expect a similar
>   interface as `xfontsel', but this is lacking.

I have been thinking myself for some time that we could do with an
improved way to select fonts.

Here's my first attempt at a "widget" (not yet integrated with Emacs
widgets) that uses xfontsel or gfontsel for font selection. Try it
out by evaluating (x-select-font).



(defcustom x-select-font-command "xfontsel"
  "*The command used by `x-select-font' to select a font.
The command should be one of those listed in
`x-select-font-command-line-alist'."
  :type '(string :match x-select-font-valid-command)
  :group 'x)

(defcustom x-select-font-command-line-alist
  '(("xfontsel" "-print" "-pattern")
    ("gfontsel" "--print" nil))
  "*Programs and associated arguments suitable for `x-select-font-command'.
The format of each entry is (PROGRAM . (STANDARD-ARGUMENTS FILTER-ARGUMENT))
where PROGRAM is the name of the program, STANDARD-ARGUMENTS are any
arguments required to make the program behave as `x-select-font' or the user
expects, and FILTER-SWITCH is a switch that can be supplied to limit
the fonts the user may choose from to those that match a pattern.  If
PROGRAM does not support filtering the list of fonts, this should be nil.
If PROGRAM accepts a filter on the command-line without a preceding switch,
then FILTER-SWITCH should be t."
  :type '(alist
          :key-type (file :tag "Program")
          :value-type (group (string :tag "Fixed Args")
                             (choice :tag "Filter Switch"
                                     (const :tag "Unsupported" nil)
                                     (other :tag "No switch" t)
                                     string)))
  :group 'x)

;; Required for x-select-font-command custom type.
(defun x-select-font-valid-command (widget program)
  "Return entry for PROGRAM in `x-select-font-command-line-alist'."
  (assoc program x-select-font-command-line-alist))


(defun x-select-font (&optional filter single-font)
  "Select a font using the  program.
Fonts to choose from can be limited by providing a FILTER.  The filter
should be a partially qualified XLFD font name.  If SINGLE-FONT is non-nil,
an error is thrown if the pattern returned matches multiple fonts."
  (with-temp-buffer
    (let* ((command-line
            (assoc x-select-font-command x-select-font-command-line-alist))
           (fixed-args (car (cdr command-line)))
           (filter-switch (car (cdr (cdr command-line))))
           (args (append (list fixed-args) (if (and filter filter-switch)
                                               (if (stringp filter-switch)
                                                   (list filter-switch filter)
                                                 filter)))))
      (apply 'call-process x-select-font-command nil t nil args)
      (if single-font
          (let ((fonts (x-list-fonts (buffer-string))))
            (if (eq (length fonts) 1)
                (car fonts)
              (error "Multiple fonts match, selection not made")))
        (buffer-string)))))

;; x-font.el ends here