Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-20 11:57:36 +00:00
Code Issues Projects Releases Packages Wiki Activity

Improve selection of fonts available from `mouse-set-font'

Browse source 
People get confused on a build without font dialogs (such as a
Lucid build) if `menu-set-font' and `mouse-set-font' don't
present them a list of the fonts actually available on their
system.

* lisp/mouse.el (mouse-generate-font-name-for-menu)
(mouse-generate-font-menu): New functions.
(mouse-select-font): Allow the user to select from all fonts
available on the system.
(mouse-set-font): Use `mouse-select-font' to display font menu.
This commit is contained in:
Po Lu 2022-02-09 11:26:47 +08:00
parent 59ff15e350
commit d41a5e7e33
1 changed files with 62 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

75
lisp/mouse.el
View file

@ -2755,18 +2755,72 @@ and selects that window."
(declare-function generate-fontset-menu "fontset" ())
(defun mouse-generate-font-name-for-menu (entity)
"Return a short name for font entity ENTITY.
The name should be used to describe ENTITY in the case that its
family is already known, such as in a pane generated by
`mouse-generate-font-menu'."
(let ((weight (font-get entity :weight))
(slant (font-get entity :slant))
(width (font-get entity :width))
(size (font-get entity :size))
(adstyle (font-get entity :adstyle))
(name ""))
(when weight
(setq name (concat name (symbol-name weight) " ")))
(when (and slant
(not (eq slant 'normal)))
(setq name (concat name (symbol-name slant) " ")))
(when (and width (not (eq width 'normal)))
(setq name (concat name (symbol-name width) " ")))
(when (and size (not (zerop size)))
(setq name (concat name (number-to-string size) " ")))
(when adstyle
(setq name (concat name (if (symbolp adstyle)
(symbol-name adstyle)
(number-to-string adstyle))
" ")))
(string-trim-right name)))
(defun mouse-generate-font-menu ()
"Return a list of menu panes for each font family."
(let ((families (font-family-list))
(panes (list "Font families")))
(dolist (family families)
(when family
(let* ((fonts (list-fonts (font-spec :family family)))
(pane (if fonts (list family)
(list family (cons family family)))))
(when fonts
(dolist (font fonts)
(setq pane
(nconc pane
(list (list (or (font-get font :name)
(mouse-generate-font-name-for-menu font))
(font-xlfd-name font)))))))
(setq panes (nconc panes (list pane))))))
panes))
(defun mouse-select-font ()
"Prompt for a font name, using `x-popup-menu', and return it."
(interactive)
(unless (display-multi-font-p)
(error "Cannot change fonts on this display"))
(car
(x-popup-menu
(if (listp last-nonmenu-event)
last-nonmenu-event
(list '(0 0) (selected-window)))
(append x-fixed-font-alist
(list (generate-fontset-menu))))))
(let ((result (car
(x-popup-menu
(if (listp last-nonmenu-event)
last-nonmenu-event
(list '(0 0) (selected-window)))
(append x-fixed-font-alist
(list (generate-fontset-menu))
'(("More Fonts" ("By Family" more))))))))
(if (eq result 'more)
(car (x-popup-menu
(if (listp last-nonmenu-event)
last-nonmenu-event
(list '(0 0) (selected-window)))
(mouse-generate-font-menu)))
result)))
(declare-function text-scale-mode "face-remap")
@ -2780,12 +2834,7 @@ choose a font."
(interactive
(progn (unless (display-multi-font-p)
(error "Cannot change fonts on this display"))
(x-popup-menu
(if (listp last-nonmenu-event)
last-nonmenu-event
(list '(0 0) (selected-window)))
;; Append list of fontsets currently defined.
(append x-fixed-font-alist (list (generate-fontset-menu))))))
(list (mouse-select-font))))
(if fonts
(let (font)
(while fonts