Mercurial > hg > xemacs-beta
diff lisp/x-font-menu.el @ 371:cc15677e0335 r21-2b1
Import from CVS: tag r21-2b1
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:03:08 +0200 |
parents | 8e84bee8ddd0 |
children | 6240c7796c7a |
line wrap: on
line diff
--- a/lisp/x-font-menu.el Mon Aug 13 11:01:58 2007 +0200 +++ b/lisp/x-font-menu.el Mon Aug 13 11:03:08 2007 +0200 @@ -130,45 +130,18 @@ ;;; (defvar font-menu-ignore-proportional-fonts nil ;;; "*If non-nil, then the font menu will only show fixed-width fonts.") -(defgroup font-menu () - "Settings for the font menu" - :group 'x) - ;;;###autoload (defcustom font-menu-ignore-scaled-fonts t "*If non-nil, then the font menu will try to show only bitmap fonts." :type 'boolean - :group 'font-menu) + :group 'x) ;;;###autoload (defcustom font-menu-this-frame-only-p nil "*If non-nil, then changing the default font from the font menu will only affect one frame instead of all frames." :type 'boolean - :group 'font-menu) - -(defcustom font-menu-max-items 25 - "*Maximum number of items in the font menu -If number of entries in a menu is larger than this value, split menu -into submenus of nearly equal length. If nil, never split menu into -submenus." - :group 'font-menu - :type '(choice (const :tag "no submenus" nil) - (integer))) - -(defcustom font-menu-submenu-name-format "%-12.12s ... %.12s" - "*Format specification of the submenu name. -Used by `font-menu-split-long-menu' if the number of entries in a menu is -larger than `font-menu-menu-max-items'. -This string should contain one %s for the name of the first entry and -one %s for the name of the last entry in the submenu. -If the value is a function, it should return the submenu name. The -function is be called with two arguments, the names of the first and -the last entry in the menu." - :group 'font-menu - :type '(choice (string :tag "Format string") - (function))) - + :group 'x) ;; only call XListFonts (and parse) once per device. ;; ( (device . [parsed-list-fonts family-menu size-menu weight-menu]) ...) @@ -385,40 +358,6 @@ (vector entry family size weight slant))) -(defun font-menu-split-long-menu (menu) - "Split MENU according to `font-menu-max-items'." - (let ((len (length menu))) - (if (or (null font-menu-max-items) - (null (featurep 'lisp-float-type)) - (<= len font-menu-max-items)) - menu - ;; Submenu is max 2 entries longer than menu, never shorter, number of - ;; entries in submenus differ by at most one (with longer submenus first) - (let* ((outer (floor (sqrt len))) - (inner (/ len outer)) - (rest (% len outer)) - (result nil)) - (setq menu (reverse menu)) - (while menu - (let ((in inner) - (sub nil) - (to (car menu))) - (while (> in 0) - (setq in (1- in) - sub (cons (car menu) sub) - menu (cdr menu))) - (setq result - (cons (cons (if (stringp font-menu-submenu-name-format) - (format font-menu-submenu-name-format - (aref (car sub) 0) (aref to 0)) - (funcall font-menu-submenu-name-format - (aref (car sub) 0) (aref to 0))) - sub) - result) - rest (1+ rest)) - (if (= rest outer) (setq inner (1+ inner))))) - result)))) - ;;;###autoload (defun font-menu-family-constructor (ignored) (catch 'menu @@ -437,23 +376,21 @@ ;; the same size and weight as the current font (scalable fonts ;; exist in every size). Only the current font is marked as ;; selected. - (font-menu-split-long-menu - (mapcar - (lambda (item) - (setq f (aref item 0) - entry (vassoc f (aref dcache 0))) - ;; The user can no longer easily control the weight using the menu - ;; Note it is silly anyway as it could very well be that the font - ;; has no common size+weight combinations with the default font. - (if (and (not (member size (aref entry 2))) - font-menu-ignore-scaled-fonts (member 0 (aref entry 2))) - (disable-menu-item item) - (enable-menu-item item)) - (if (string-equal family f) - (select-toggle-menu-item item) - (deselect-toggle-menu-item item)) - item) - (aref dcache 1)))))) + (mapcar + (lambda (item) + (setq f (aref item 0) + entry (vassoc f (aref dcache 0))) + (if (and (member weight (aref entry 1)) + (or (member size (aref entry 2)) + (and (not font-menu-ignore-scaled-fonts) + (member 0 (aref entry 2))))) + (enable-menu-item item) + (disable-menu-item item)) + (if (string-equal family f) + (select-toggle-menu-item item) + (deselect-toggle-menu-item item)) + item) + (aref dcache 1))))) ;;;###autoload (defun font-menu-size-constructor (ignored) @@ -529,12 +466,9 @@ (from-size (aref font-data 2)) (from-weight (aref font-data 3)) (from-slant (aref font-data 4)) - new-default-face-font - new-props) + new-default-face-font) (unless from-family (signal 'error '("couldn't parse font name for default face"))) - (when weight - (signal 'error '("Setting weight currently not supported"))) (setq new-default-face-font (font-menu-load-font (or family from-family) (or weight from-weight) @@ -554,19 +488,10 @@ ;; Set the default face's font after hacking the other faces, so that ;; the frame size doesn't change until we are all done. - ;; If we need to be frame local we do the changes ourselves. - (if font-menu-this-frame-only-p ;;; WMP - we need to honor font-menu-this-frame-only-p here! - (set-face-font 'default new-default-face-font - (and font-menu-this-frame-only-p (selected-frame))) - ;; OK Let Customize do it. - (when (and family (not (equal family from-family))) - (setq new-props (append (list :family family) new-props))) - (when (and size (not (equal size from-size))) - (setq new-props (append - (list :size (concat (int-to-string (/ size 10)) "pt")) new-props))) - (custom-set-face-update-spec 'default '((type x)) new-props) - (message "Font %s" (face-font-name 'default))))) + (set-face-font 'default new-default-face-font + (and font-menu-this-frame-only-p (selected-frame))) + (message "Font %s" (face-font-name 'default)))) (defun font-menu-change-face (face