Interactive font selector

Interactive font selector

[Simon Josefsson]

A feature request I have no idea how to implement:

Many word processors and text editors have a menu display on the
toolbar where you can select the font to display text in.  Text
editors usually use it simply change the font to display all text in,
whereas word processors use it to change the font of new text you will
write.

Both features seems useful in Emacs, depending on which mode you are
in.

(I use the term "font" here loosely, meaning slant, size, font
familly, color, etc.)

Re: Interactive font selector

[Richard Stallman]

    Many word processors and text editors have a menu display on the
    toolbar where you can select the font to display text in.

We have something like this already, in the Text Properties menu.  It
lets you set various aspects of the face, including colors and slant.
But it does not handle the font family (or the size).

The main question is, which fonts should it offer?
What do other programs offer?  Can you design a UI to use?

Once we can settle that, this may not be too hard to write.
I am sure you could write it.

Re: Interactive font selector

[Henrik Enberg]

Richard Stallman <rms@gnu.org> writes:

>     Many word processors and text editors have a menu display on the
>     toolbar where you can select the font to display text in.
>
> We have something like this already, in the Text Properties menu.  It
> lets you set various aspects of the face, including colors and slant.
> But it does not handle the font family (or the size).

Speaking of which,  The menu for changing the actual font is hidden
down in "Options > Mule > Set Font/Fontset".  I think that is a
non-obvious place for such a menu.  It would make sense to merge it
with the text properties menu.

-- 
Booting... /vmemacs.el

Re: Interactive font selector

[Simon Josefsson]

Richard Stallman <rms@gnu.org> writes:

>     Many word processors and text editors have a menu display on the
>     toolbar where you can select the font to display text in.
>
> We have something like this already, in the Text Properties menu.  It
> lets you set various aspects of the face, including colors and slant.
> But it does not handle the font family (or the size).

Can you chose color with it?

> The main question is, which fonts should it offer?
> What do other programs offer?  Can you design a UI to use?
>
> Once we can settle that, this may not be too hard to write.
> I am sure you could write it.

To really be usable and similar to other applications, emacs need to
reimplement some GTK widgets (or of course, start to use GTK).  Many
GTK programs offer this UI already, having toolbar buttons for font,
slant, color etc.  When there is a GTK toolbar, adding a pull-down
font menu and expandable color choser is probably not very difficult,
but implementing those widgets in Emacs now seem like major work.
What is the status of the GTK support?

Re: Interactive font selector

[Richard Stallman]

    Speaking of which,  The menu for changing the actual font is hidden
    down in "Options > Mule > Set Font/Fontset".  I think that is a
    non-obvious place for such a menu.  It would make sense to merge it
    with the text properties menu.

I think that command sets the default font of the frame, doesn't it?
That's a different job.  I agree that is a strange place for it; I
think it should be directly in the Options menu.  Would someone
like to move it there?

Re: Interactive font selector

[Richard Stallman]

    To really be usable and similar to other applications, emacs need to
    reimplement some GTK widgets (or of course, start to use GTK).

We don't need this large change to add the specific feature that
you've proposed.

    What is the status of the GTK support?

I am curious too.  Who remembers who was working on that?

Re: Interactive font selector

[Jan D.]

> 
>     What is the status of the GTK support?
> 
> I am curious too.  Who remembers who was working on that?

I was (am) working on that.  However, things has happened I cant control, and
as a result, I have had no time to devote to Emacs in the last 4 months
or so.  I very seldom find time to read this list even.

But my ambition is to finish the job.  I suspect it will be late fall
before something useful can be checked in into CVS.

	Jan D.

Re: Interactive font selector

[Jason Rumney]

Richard Stallman <rms@gnu.org> writes:

>     To really be usable and similar to other applications, emacs need to
>     reimplement some GTK widgets (or of course, start to use GTK).
> 
> We don't need this large change to add the specific feature that
> you've proposed.

I have the following code that implements interactive font selection
on X, using either gfontsel or xfontsel (or some other user specified
command).  It contains a replacement mouse-set-font, which adds an
extra submenu (I could not find a way to easily add a top level menu
item using easymenu), and an interactive function
`set-font-for-face-at-point', which could be used in the Text
Properties menu.


;;; Experimental font selection with a dialog.

(defcustom x-select-font-commands
  '(("gfontsel" "--print" "-f" nil)
    ("xfontsel" "-print" nil "-pattern"))
  "*Programs and associated arguments for selecting fonts.
`x-select-font' will use the first program from this list that can be
found in the executable path.

The format of each entry is

 (PROGRAM STANDARD-ARGUMENTS INITIAL-SWITCH FILTER-SWITCH)

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, INITIAL-SWITCH is a switch to specify the font initially selected
in the dialog, and FILTER-SWITCH is a switch that can be supplied to limit
the fonts the user may choose from.

If PROGRAM does not support setting the initial font or filtering the list
of fonts, the corresponding switch should be set to nil.
If PROGRAM accepts a filter or an initial font on the command-line without
a preceding switch, then the corresponding switch should be set to t."
  :type '(alist
	  :key-type (file :tag "Program")
	  :value-type (group (string :tag "Fixed Args")
			     (choice :tag "Initial Font Switch"
				     (const :tag "Unsupported" nil)
				     (other :tag "No switch" t)
				     string)
			     (choice :tag "Filter Switch"
				     (const :tag "Unsupported" nil)
				     (other :tag "No switch" t)
				     string)))
  :group 'x)

(defvar x-select-font-command-cached nil
  "The command last used by `x-select-font' to select a font.
If nil, x-select-font will try to find a suitable program from
`x-select-font-commands'.")

(defun x-select-font (&optional initial filter)
  "Select a font using one of the programs in `x-select-font-commands'.
The font initially selected in the font dialog can optionally be set
with INITIAL if supported by `x-font-select-font-command'.  The range of
fonts to choose from can be limited by providing a FILTER, if supported.
The filter should be a partially qualified XLFD font name."
  (with-temp-buffer
    (let* ((command
	    (or x-select-font-command-cached
		(let ((cmds x-select-font-commands)
		      this-cmd)
		  (while (and cmds (not x-select-font-command-cached))
		    (setq this-cmd (car (car cmds)))
		    (if (executable-find this-cmd)
			(setq x-select-font-command-cached this-cmd))
		    (setq cmds (cdr cmds)))
		  x-select-font-command-cached)))
	   (command-line
	    (assoc command x-select-font-commands))
	   (fixed-args (if command-line (nth 1 command-line)))
	   (initial-switch (if command-line (nth 2 command-line)))
	   (filter-switch (if command-line (nth 3 command-line)))
	   (args (append (list fixed-args)
			 (if (and filter filter-switch)
			     (if (stringp filter-switch)
				 (list filter-switch filter)
			       filter))
			 (if (and initial initial-switch)
			     (if (stringp initial-switch)
				 (list initial-switch initial)
			       initial)))))
      (apply 'call-process command nil '(t nil) nil args)
      (buffer-string))))

(defcustom x-select-font-refine-menu-limit 20
  "*Limit on the size of the font refine menu.
When `x-select-font' is used to choose a font in a context that requires
a single font to match, there is a possibility that the pattern returned
from `x-select-font' matches multiple fonts.  This variable sets an upper
limit on the number of fonts that can be matched by the return value
of `x-select-font' before an error is thrown."
  :type 'integer
  :group 'x)

(defun x-select-font-refine-with-menu (fonts menu-pos)
  "Refine a list of fonts by popping up a menu."
  (let ((font-list fonts)
	font-refine-menu
	this-font)
    (while font-list
      (setq this-font (car font-list) font-list (cdr font-list))
      (setq font-refine-menu (cons (list this-font this-font)
				   font-refine-menu)))
    (setq font-refine-menu (cons "Refine Font"
				 (list (append '("Font List")
					       font-refine-menu))))
    (x-popup-menu menu-pos font-refine-menu)))

(defun x-select-single-font (&optional initial filter)
  "Select a single font, using `x-select-font-command'.
If neccesary, pop up a menu to refine the choices further."
  (interactive)
  ;; Take note of the mouse position now while the frame is active.
  ;; Translate it to what x-popup-menu expects.
  (let* ((menu-pos (mouse-pixel-position))
	 (menu-pos-window (car menu-pos))
	 (menu-pos-x (car (cdr menu-pos)))
	 (menu-pos-y (cdr (cdr menu-pos)))
	 (menu-pos-expected-format (list
				    (list (if menu-pos-x menu-pos-x
					    0)
					  (if menu-pos-y menu-pos-y
					    0))
				    menu-pos-window))
	 (font-pattern (x-select-font initial filter))
	 (font-list (or (x-list-fonts font-pattern)
			(list font-pattern)))
			
	 (nfonts (length font-list)))
    (cond ((eq font-list nil)
	   (error "No fonts match."))
	  ((eq nfonts 1)
	   (car font-list))
	  ((< nfonts x-select-font-refine-menu-limit)
	   (car (x-select-font-refine-with-menu
		 font-list menu-pos-expected-format)))
	  (t
	   (error "Too many fonts match.")))))


(defun x-select-font-for-face (face frame)
 "Select the font to be used for FACE on FRAME.
`x-select-font-command' will be used to make the selection."
 (let ((family (face-attribute face :family frame 'default))
       (width (face-attribute face :width frame 'default))
       (height (face-attribute face :height frame 'default))
       (weight (face-attribute face :weight frame 'default))
       (slant (face-attribute face :slant frame 'default))
       (font (face-attribute face :font frame nil))
       new-font new-attributes)
   (if (eq font 'unspecified)
       (setq font nil))
   (setq new-font
	 (x-select-font
	  (if font
	      font
	    (x-compose-font-name
	     (list nil family weight slant nil nil
		   (if (integerp height) height nil)
		   (if (integerp height) nil (floor (* 10 height)))
		   nil nil nil width nil nil)))))
   ;; If face was specified by a :font attribute, replace it with the new one
   (if font
       (set-face-attribute face frame :font new-font)
     ;; Otherwise replace changed attributes individually.
     (setq new-attributes (x-decompose-font-name new-font))
     (if (not (equal (nth 2 new-attributes) family))
	 (set-face-attribute face frame :family (nth 2 new-attributes)))
     (if (not (equal (nth 3 new-attributes) weight))
	 (set-face-attribute face frame :weight (nth 3 new-attributes)))
     (if (not (equal (nth 4 new-attributes) slant))
	 (set-face-attribute face frame :slant (nth 4 new-attributes)))
     ;; If height was in pixels before, keep it in pixels.
     (if (integerp height)
	 (if (not (equal (nth 7 new-attributes) height))
	     (set-face-attribute face frame :height
				 (nth 7 new-attributes)))
       (let ((float-height (/ (nth 8 new-attributes) 10.0)))
	 (if (not (equal float-height height))
	     (set-face-attribute face frame :height float-height))))
     (if (not (equal (nth 12 new-attributes) width))
	 (set-face-attribute face frame :width (nth 12 new-attributes))))))

;; Replacement mouse-set-font ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; The following adds an extra submenu with a single option, which
;; launches the font dialog.  It would be nicer to do this with
;; an item on the main menu instead of a submenu, but that involves
;; more code changes.

(setq x-fixed-font-alist (append x-fixed-font-alist '(("More fonts" ("Choose..." . x-select-single-font)))))

(defun mouse-set-font (&rest fonts)
  "Select an emacs font from a list of known good fonts and fontsets."
  (interactive
   (and (display-multi-font-p)
	(let ((selected-font (x-popup-menu
			      last-nonmenu-event
			      ;; Append list of fontsets currently defined.
			      (append x-fixed-font-alist
				      (list (generate-fontset-menu))))))
	  (if (functionp selected-font)
	      (list (call-interactively selected-font))
	    selected-font))))
  (message "%S" fonts)
  (if fonts
      (let (font)
	(while fonts
	  (condition-case nil
	      (progn
		(set-default-font (car fonts))
		(setq font (car fonts))
		(setq fonts nil))
	    (error
	     (setq fonts (cdr fonts)))))
	(if (null font)
	    (error "Font not found")))
    (message "Cannot change fonts on this display")))


;; Selecting a font for a face ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun set-font-for-face-at-point ()
  "Set the font to use for the face currently under point."
  (interactive)
  (let ((face (get-text-property (point) 'face)))
    (x-select-font-for-face (if face face 'default) nil)))

Re: Interactive font selector

[Richard Stallman]

    But my ambition is to finish the job.  I suspect it will be late fall
    before something useful can be checked in into CVS.

This is disappointing news, but the feature will still be useful then.

Re: Interactive font selector

[Richard Stallman]

This looks like a big step forward.  We need to figure out the right
interface for using the new method, though.

    (defun x-select-font-for-face (face frame)
     "Select the font to be used for FACE on FRAME.
    `x-select-font-command' will be used to make the selection."

That seems like a rather strange way to do things.

    (defun set-font-for-face-at-point ()
      "Set the font to use for the face currently under point."

That also seems strange.  When the user wants to specify a font for
the text, he would want it to work either directly (not using a
particular face) or by creating a new face, not by changing an old one.