Mercurial > hg > xemacs-beta

comparison lisp/x-font-menu.el @ 375:a300bb07d72d r21-2b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b3
author cvs
date Mon, 13 Aug 2007 11:04:51 +0200
parents 6240c7796c7a
children 74fd4e045ea6
comparison
equal deleted inserted replaced
374:4ebeb1a5388b 375:a300bb07d72d
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)