Mercurial > hg > xemacs-beta

comparison lisp/x-font-menu.el @ 321:19dcec799385 r21-0-58

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0-58
author cvs
date Mon, 13 Aug 2007 10:46:44 +0200
parents 512e409c26a2
children 8bec6624d99b
comparison
equal deleted inserted replaced
320:73c75c43c1f2 321:19dcec799385
470 new-props) 470 new-props)
471 (unless from-family 471 (unless from-family
472 (signal 'error '("couldn't parse font name for default face"))) 472 (signal 'error '("couldn't parse font name for default face")))
473 (when weight 473 (when weight
474 (signal 'error '("Setting weight currently not supported"))) 474 (signal 'error '("Setting weight currently not supported")))
475 ; (setq new-default-face-font 475 (setq new-default-face-font
476 ; (font-menu-load-font (or family from-family) 476 (font-menu-load-font (or family from-family)
477 ; (or weight from-weight) 477 (or weight from-weight)
478 ; (or size from-size) 478 (or size from-size)
479 ; from-slant 479 from-slant
480 ; font-menu-preferred-resolution)) 480 font-menu-preferred-resolution))
481 (dolist (face (delq 'default (face-list))) 481 (dolist (face (delq 'default (face-list)))
482 (when (face-font-instance face) 482 (when (face-font-instance face)
483 (message "Changing font of `%s'..." face) 483 (message "Changing font of `%s'..." face)
484 (condition-case c 484 (condition-case c
485 (font-menu-change-face face 485 (font-menu-change-face face
488 (error 488 (error
489 (display-error c nil) 489 (display-error c nil)
490 (sit-for 1))))) 490 (sit-for 1)))))
491 ;; Set the default face's font after hacking the other faces, so that 491 ;; Set the default face's font after hacking the other faces, so that
492 ;; the frame size doesn't change until we are all done. 492 ;; the frame size doesn't change until we are all done.
493 493
494 (when (and family (not (equal family from-family))) 494 ;; If we need to be frame local we do the changes ourselves.
495 (setq new-props (append (list :family family) new-props))) 495 (if font-menu-this-frame-only-p
496 (when (and size (not (equal size from-size))) 496 ;;; WMP - we need to honor font-menu-this-frame-only-p here!
497 (setq new-props (append (list :size (concat (int-to-string 497 (set-face-font 'default new-default-face-font
498 (/ size 10)) "pt")) new-props))) 498 (and font-menu-this-frame-only-p (selected-frame)))
499 (custom-set-face-update-spec 'default '((type x)) new-props) 499 ;; OK Let Customize do it.
500 ;;; WMP - we need to honor font-menu-this-frame-only-p here! 500 (when (and family (not (equal family from-family)))
501 ; (set-face-font 'default new-default-face-font 501 (setq new-props (append (list :family family) new-props)))
502 ; (and font-menu-this-frame-only-p (selected-frame))) 502 (when (and size (not (equal size from-size)))
503 (message "Font %s" (face-font-name 'default)))) 503 (setq new-props (append
504 (list :size (concat (int-to-string (/ size 10)) "pt")) new-props)))
505 (custom-set-face-update-spec 'default '((type x)) new-props)
506 (message "Font %s" (face-font-name 'default)))))
504 507
505 508
506 (defun font-menu-change-face (face 509 (defun font-menu-change-face (face
507 from-family from-weight from-size 510 from-family from-weight from-size
508 to-family to-weight to-size) 511 to-family to-weight to-size)