Mercurial > hg > xemacs-beta

comparison lisp/font-menu.el @ 5118:e0db3c197671 ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
5117:3742ea8250b5 5118:e0db3c197671
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 new-spec-list)
367 "pt"))) 370 ;; If the font was initialised from X resources (the tag-set
368 (message "Font %s" (face-font-name 'default))))) 371 ;; contains 'x-resource) pretend to Custom that it has
369 372 ;; responsibility for those settings.
373 (map-specifier (face-font 'default)
374 (lambda (spec locale inst-list arg)
375 (loop
376 for (tag-set . inst)
377 in inst-list
378 do (setq tag-set (delq 'x-resource tag-set)
379 tag-set (delq 'custom tag-set)
380 tag-set (cons 'custom tag-set))
381 (push (cons tag-set inst) new-spec-list)
382 ;; Need to return nil, else map-specifier stops
383 finally return nil))
384 nil nil '(x-resource))
385 (remove-specifier (face-font 'default) nil '(x-resource))
386 (when new-spec-list
387 (add-spec-list-to-specifier (face-font 'default)
388 (list (cons 'global new-spec-list))))
389 (custom-set-face-update-spec 'default
390 (list (list 'type (device-type)))
391 (list :family (or family from-family)
392 :size fsize))))
393 (message "Font %s" (face-font-name 'default))))
370 394
371 ;; #### This should be called `font-menu-maybe-change-face' 395 ;; #### This should be called `font-menu-maybe-change-face'
372 ;; I wonder if a better API wouldn't (face attribute from to) 396 ;; I wonder if a better API wouldn't (face attribute from to)
373 (defun font-menu-change-face (face 397 (defun font-menu-change-face (face
374 from-family from-weight from-size 398 from-family from-weight from-size