Mercurial > hg > xemacs-beta

comparison lisp/font-menu.el @ 3094:ad2f4ae9895b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-11-26 11:45:47 by stephent] Xft merge. <87k6ev4p8q.fsf@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Sat, 26 Nov 2005 11:46:25 +0000
parents 491f8cf78a9c
children 049dc907c17a
comparison
equal deleted inserted replaced
3093:769dc945b085 3094:ad2f4ae9895b
262 (if (or (member s (aref entry 2)) 262 (if (or (member s (aref entry 2))
263 (and (not font-menu-ignore-scaled-fonts) 263 (and (not font-menu-ignore-scaled-fonts)
264 (member 0 (aref entry 2)))) 264 (member 0 (aref entry 2))))
265 (enable-menu-item item) 265 (enable-menu-item item)
266 (disable-menu-item item)) 266 (disable-menu-item item))
267 (if (eq size s) 267 ;; #### God save the Queen!
268 ;; well, if this fails because s or size is non-numeric, fuck 'em
269 (if (= size (if (featurep 'xft-fonts) (float s) s))
268 (select-toggle-menu-item item) 270 (select-toggle-menu-item item)
269 (deselect-toggle-menu-item item)) 271 (deselect-toggle-menu-item item))
270 item) 272 item)
271 (submenu-generate-accelerator-spec (aref dcache 2)))))) 273 (submenu-generate-accelerator-spec (aref dcache 2))))))
272 274
343 from-family from-weight from-size 345 from-family from-weight from-size
344 (or family from-family) 346 (or family from-family)
345 (or weight from-weight) 347 (or weight from-weight)
346 (or size from-size)) 348 (or size from-size))
347 (error 349 (error
350 (message "Error updating font of `%s'" face)
348 (display-error c nil) 351 (display-error c nil)
349 (sit-for 1))))) 352 (sit-for 1)))))
350 ;; Set the default face's font after hacking the other faces, so that 353 ;; Set the default face's font after hacking the other faces, so that
351 ;; the frame size doesn't change until we are all done. 354 ;; the frame size doesn't change until we are all done.
352 355
354 (if font-menu-this-frame-only-p 357 (if font-menu-this-frame-only-p
355 ;;; WMP - we need to honor font-menu-this-frame-only-p here! 358 ;;; WMP - we need to honor font-menu-this-frame-only-p here!
356 (set-face-font 'default new-default-face-font 359 (set-face-font 'default new-default-face-font
357 (and font-menu-this-frame-only-p (selected-frame))) 360 (and font-menu-this-frame-only-p (selected-frame)))
358 ;; OK Let Customize do it. 361 ;; OK Let Customize do it.
359 (custom-set-face-update-spec 'default 362 (let ((fsize (if (featurep 'xft-fonts)
360 (list (list 'type (device-type))) 363 (int-to-string (or size from-size))
361 (list :family (or family from-family) 364 (concat (int-to-string
362 :size (concat 365 (/ (or size from-size)
363 (int-to-string 366 (specifier-instance font-menu-size-scaling
364 (/ (or size from-size) 367 (selected-device))))
365 (specifier-instance font-menu-size-scaling 368 "pt"))))
366 (selected-device)))) 369 (custom-set-face-update-spec 'default
367 "pt"))) 370 (list (list 'type (device-type)))
368 (message "Font %s" (face-font-name 'default))))) 371 (list :family (or family from-family)
372 :size fsize))))
373 (message "Font %s" (face-font-name 'default))))
369 374
370 375
371 ;; #### This should be called `font-menu-maybe-change-face' 376 ;; #### This should be called `font-menu-maybe-change-face'
372 ;; I wonder if a better API wouldn't (face attribute from to) 377 ;; I wonder if a better API wouldn't (face attribute from to)
373 (defun font-menu-change-face (face 378 (defun font-menu-change-face (face