[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master d41a5e7e33: Improve selection of fonts available from `mouse-set-
From: |
Po Lu |
Subject: |
master d41a5e7e33: Improve selection of fonts available from `mouse-set-font' |
Date: |
Tue, 8 Feb 2022 22:28:53 -0500 (EST) |
branch: master
commit d41a5e7e33067eb38b147ee2f8a1615f6faed7a4
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Improve selection of fonts available from `mouse-set-font'
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.
---
lisp/mouse.el | 75 ++++++++++++++++++++++++++++++++++++++++++++++++-----------
1 file changed, 62 insertions(+), 13 deletions(-)
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 502683d3d1..acaf6611af 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master d41a5e7e33: Improve selection of fonts available from `mouse-set-font',
Po Lu <=