Mercurial > hg > xemacs-beta
diff lisp/font-menu.el @ 5118:e0db3c197671 ben-lisp-object
merge up to latest default branch, doesn't compile yet
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Sat, 26 Dec 2009 21:18:49 -0600 |
parents | 049dc907c17a |
children | 3889ef128488 308d34e9f07d |
line wrap: on
line diff
--- a/lisp/font-menu.el Sat Dec 26 00:20:27 2009 -0600 +++ b/lisp/font-menu.el Sat Dec 26 21:18:49 2009 -0600 @@ -264,7 +264,9 @@ (member 0 (aref entry 2)))) (enable-menu-item item) (disable-menu-item item)) - (if (eq size s) + ;; #### God save the Queen! + ;; well, if this fails because s or size is non-numeric, fuck 'em + (if (= size (if (featurep 'xft-fonts) (float s) s)) (select-toggle-menu-item item) (deselect-toggle-menu-item item)) item) @@ -345,6 +347,7 @@ (or weight from-weight) (or size from-size)) (error + (message "Error updating font of `%s'" face) (display-error c nil) (sit-for 1))))) ;; Set the default face's font after hacking the other faces, so that @@ -356,17 +359,38 @@ (set-face-font 'default new-default-face-font (and font-menu-this-frame-only-p (selected-frame))) ;; OK Let Customize do it. - (custom-set-face-update-spec 'default - (list (list 'type (device-type))) - (list :family (or family from-family) - :size (concat - (int-to-string - (/ (or size from-size) - (specifier-instance font-menu-size-scaling - (selected-device)))) - "pt"))) - (message "Font %s" (face-font-name 'default))))) - + (let ((fsize (if (featurep 'xft-fonts) + (int-to-string (or size from-size)) + (concat (int-to-string + (/ (or size from-size) + (specifier-instance font-menu-size-scaling + (selected-device)))) + "pt"))) + new-spec-list) + ;; If the font was initialised from X resources (the tag-set + ;; contains 'x-resource) pretend to Custom that it has + ;; responsibility for those settings. + (map-specifier (face-font 'default) + (lambda (spec locale inst-list arg) + (loop + for (tag-set . inst) + in inst-list + do (setq tag-set (delq 'x-resource tag-set) + tag-set (delq 'custom tag-set) + tag-set (cons 'custom tag-set)) + (push (cons tag-set inst) new-spec-list) + ;; Need to return nil, else map-specifier stops + finally return nil)) + nil nil '(x-resource)) + (remove-specifier (face-font 'default) nil '(x-resource)) + (when new-spec-list + (add-spec-list-to-specifier (face-font 'default) + (list (cons 'global new-spec-list)))) + (custom-set-face-update-spec 'default + (list (list 'type (device-type))) + (list :family (or family from-family) + :size fsize)))) + (message "Font %s" (face-font-name 'default)))) ;; #### This should be called `font-menu-maybe-change-face' ;; I wonder if a better API wouldn't (face attribute from to)