Commit 1900a92b authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(x-fixed-font-alist): Give multiple names for try for certain fonts.

(mouse-set-font): Handle these.
parent d49ab5a0
...@@ -1242,14 +1242,14 @@ and selects that window." ...@@ -1242,14 +1242,14 @@ and selects that window."
(defvar x-fixed-font-alist (defvar x-fixed-font-alist
'("Font menu" '("Font menu"
("Misc" ("Misc"
("6x10" "-misc-fixed-medium-r-normal--10-100-75-75-c-60-*-1") ("6x10" "-misc-fixed-medium-r-normal--10-100-75-75-c-60-*-1" "6x10")
("6x12" "-misc-fixed-medium-r-semicondensed--12-110-75-75-c-60-*-1") ("6x12" "-misc-fixed-medium-r-semicondensed--12-110-75-75-c-60-*-1" "6x12")
("6x13" "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-*-1") ("6x13" "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-*-1" "6x13")
("lucida 13" ("lucida 13"
"-b&h-lucidatypewriter-medium-r-normal-sans-0-0-0-0-m-0-*-1") "-b&h-lucidatypewriter-medium-r-normal-sans-0-0-0-0-m-0-*-1")
("7x13" "-misc-fixed-medium-r-normal--13-120-75-75-c-70-*-1") ("7x13" "-misc-fixed-medium-r-normal--13-120-75-75-c-70-*-1" "7x13")
("7x14" "-misc-fixed-medium-r-normal--14-130-75-75-c-70-*-1") ("7x14" "-misc-fixed-medium-r-normal--14-130-75-75-c-70-*-1" "7x14")
("9x15" "-misc-fixed-medium-r-normal--15-140-*-*-c-*-*-1") ("9x15" "-misc-fixed-medium-r-normal--15-140-*-*-c-*-*-1" "9x15")
("") ("")
("clean 8x8" "-schumacher-clean-medium-r-normal--*-80-*-*-c-*-*-1") ("clean 8x8" "-schumacher-clean-medium-r-normal--*-80-*-*-c-*-*-1")
("clean 8x14" "-schumacher-clean-medium-r-normal--*-140-*-*-c-*-*-1") ("clean 8x14" "-schumacher-clean-medium-r-normal--*-140-*-*-c-*-*-1")
...@@ -1298,37 +1298,47 @@ and selects that window." ...@@ -1298,37 +1298,47 @@ and selects that window."
) )
"X fonts suitable for use in Emacs.") "X fonts suitable for use in Emacs.")
(defun mouse-set-font (&optional font) (defun mouse-set-font (&rest fonts)
"Select an emacs font from a list of known good fonts" "Select an emacs font from a list of known good fonts"
(interactive (interactive
(x-popup-menu last-nonmenu-event x-fixed-font-alist)) (x-popup-menu last-nonmenu-event x-fixed-font-alist))
(if font (let (font)
(progn (modify-frame-parameters (selected-frame) (setq foo font bar fonts)
(list (cons 'font font))) (while fonts
;; Update some standard faces too. (condition-case nil
(set-face-font 'bold nil (selected-frame)) (progn
(make-face-bold 'bold (selected-frame) t) (modify-frame-parameters (selected-frame)
(set-face-font 'italic nil (selected-frame)) (list (cons 'font (car fonts))))
(make-face-italic 'italic (selected-frame) t) (setq font (car fonts))
(set-face-font 'bold-italic nil (selected-frame)) (setq fonts nil))
(make-face-bold-italic 'bold-italic (selected-frame) t) (error (setq fonts (cdr fonts)))))
;; Update any nonstandard faces whose definition is (if font
;; "a bold/italic/bold&italic version of the frame's font". (progn
(let ((rest global-face-data)) ;; Update some standard faces too.
(while rest (set-face-font 'bold nil (selected-frame))
(condition-case nil (make-face-bold 'bold (selected-frame) t)
(if (listp (face-font (cdr (car rest)))) (set-face-font 'italic nil (selected-frame))
(let ((bold (memq 'bold (face-font (cdr (car rest))))) (make-face-italic 'italic (selected-frame) t)
(italic (memq 'italic (face-font (cdr (car rest)))))) (set-face-font 'bold-italic nil (selected-frame))
(if (and bold italic) (make-face-bold-italic 'bold-italic (selected-frame) t)
(make-face-bold-italic (car (car rest)) (selected-frame)) ;; Update any nonstandard faces whose definition is
(if bold ;; "a bold/italic/bold&italic version of the frame's font".
(make-face-bold (car (car rest)) (selected-frame)) (let ((rest global-face-data))
(if italic (while rest
(make-face-italic (car (car rest)) (selected-frame))))))) (condition-case nil
(error nil)) (if (listp (face-font (cdr (car rest))))
(setq rest (cdr rest)))) (let ((bold (memq 'bold (face-font (cdr (car rest)))))
))) (italic (memq 'italic (face-font (cdr (car rest))))))
(if (and bold italic)
(make-face-bold-italic (car (car rest)) (selected-frame))
(if bold
(make-face-bold (car (car rest)) (selected-frame))
(if italic
(make-face-italic (car (car rest)) (selected-frame)))))))
(error nil))
(setq rest (cdr rest))))
)
(error "Font not found"))))
;;; Bindings for mouse commands. ;;; Bindings for mouse commands.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment