Mercurial > hg > xemacs-beta

comparison lisp/x-font-menu.el @ 314:341dac730539 r21-0b55

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b55
author cvs
date Mon, 13 Aug 2007 10:44:22 +0200
parents 41ff10fd062f
children 512e409c26a2
comparison
equal deleted inserted replaced
313:2905de29931f 314:341dac730539
464 (font-data (font-menu-font-data 'default dcache)) 464 (font-data (font-menu-font-data 'default dcache))
465 (from-family (aref font-data 1)) 465 (from-family (aref font-data 1))
466 (from-size (aref font-data 2)) 466 (from-size (aref font-data 2))
467 (from-weight (aref font-data 3)) 467 (from-weight (aref font-data 3))
468 (from-slant (aref font-data 4)) 468 (from-slant (aref font-data 4))
469 new-default-face-font) 469 new-default-face-font
470 new-props)
470 (unless from-family 471 (unless from-family
471 (signal 'error '("couldn't parse font name for default face"))) 472 (signal 'error '("couldn't parse font name for default face")))
472 (setq new-default-face-font 473 (when weight
473 (font-menu-load-font (or family from-family) 474 (signal 'error '("Setting weight currently not supported")))
474 (or weight from-weight) 475 ; (setq new-default-face-font
475 (or size from-size) 476 ; (font-menu-load-font (or family from-family)
476 from-slant 477 ; (or weight from-weight)
477 font-menu-preferred-resolution)) 478 ; (or size from-size)
479 ; from-slant
480 ; font-menu-preferred-resolution))
478 (dolist (face (delq 'default (face-list))) 481 (dolist (face (delq 'default (face-list)))
479 (when (face-font-instance face) 482 (when (face-font-instance face)
480 (message "Changing font of `%s'..." face) 483 (message "Changing font of `%s'..." face)
481 (condition-case c 484 (condition-case c
482 (font-menu-change-face face 485 (font-menu-change-face face
485 (error 488 (error
486 (display-error c nil) 489 (display-error c nil)
487 (sit-for 1))))) 490 (sit-for 1)))))
488 ;; 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
489 ;; the frame size doesn't change until we are all done. 492 ;; the frame size doesn't change until we are all done.
490 493
491 ;;; WMP - we need to honor font-menu-this-frame-only-p here! 494 (when (and family (not (equal family from-family)))
492 (set-face-font 'default new-default-face-font 495 (setq new-props (append (list :family family) new-props)))
493 (and font-menu-this-frame-only-p (selected-frame))) 496 (when (and size (not (equal size from-size)))
497 (setq new-props (append (list :size (int-to-string
498 (/ size 10))) new-props)))
499 (custom-set-face-update-spec 'default '((type x)) new-props)
500 ;;; WMP - we need to honor font-menu-this-frame-only-p here!
501 ; (set-face-font 'default new-default-face-font
502 ; (and font-menu-this-frame-only-p (selected-frame)))
494 (message "Font %s" (face-font-name 'default)))) 503 (message "Font %s" (face-font-name 'default))))
495 504
496 505
497 (defun font-menu-change-face (face 506 (defun font-menu-change-face (face
498 from-family from-weight from-size 507 from-family from-weight from-size