Mercurial > hg > xemacs-beta

comparison lisp/x11/x-faces.el @ 28:1917ad0d78d7 r19-15b97

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b97
author cvs
date Mon, 13 Aug 2007 08:51:55 +0200
parents 441bb1e64a06
children ec9a17fef872
comparison
equal deleted inserted replaced
27:0a3286277d9b 28:1917ad0d78d7
369 ;;; 369 ;;;
370 ;;; This had better not signal an error. The frame is in an intermediate 370 ;;; This had better not signal an error. The frame is in an intermediate
371 ;;; state where signalling an error or entering the debugger would likely 371 ;;; state where signalling an error or entering the debugger would likely
372 ;;; result in a crash. 372 ;;; result in a crash.
373 373
374 (defun x-init-face-from-resources (face locale) 374 (defun x-init-face-from-resources (face &optional locale set-anyway)
375
375 ;; 376 ;;
376 ;; These are things like "attributeForeground" instead of simply 377 ;; These are things like "attributeForeground" instead of simply
377 ;; "foreground" because people tend to do things like "*foreground", 378 ;; "foreground" because people tend to do things like "*foreground",
378 ;; which would cause all faces to be fully qualified, making faces 379 ;; which would cause all faces to be fully qualified, making faces
379 ;; inherit attributes in a non-useful way. So we've made them slightly 380 ;; inherit attributes in a non-useful way. So we've made them slightly
382 ;; 383 ;;
383 ;; I think these should be called "face.faceForeground" instead of 384 ;; I think these should be called "face.faceForeground" instead of
384 ;; "face.attributeForeground", but they're the way they are for 385 ;; "face.attributeForeground", but they're the way they are for
385 ;; hysterical reasons. (jwz) 386 ;; hysterical reasons. (jwz)
386 387
387 (let* ((face-sym (face-name face)) 388 (let* ((append (if set-anyway nil 'append))
389 (face-sym (face-name face))
388 (name (symbol-name face-sym)) 390 (name (symbol-name face-sym))
389 (fn (x-get-resource-and-maybe-bogosity-check 391 (fn (x-get-resource-and-maybe-bogosity-check
390 (concat name ".attributeFont") 392 (concat name ".attributeFont")
391 "Face.AttributeFont" 393 "Face.AttributeFont"
392 'string locale)) 394 'string locale))
457 "cursorColor" "CursorColor" 'string locale) bg))) 459 "cursorColor" "CursorColor" 'string locale) bg)))
458 ;; #### should issue warnings? I think this should be 460 ;; #### should issue warnings? I think this should be
459 ;; done when the instancing actually happens, but I'm not 461 ;; done when the instancing actually happens, but I'm not
460 ;; sure how it should actually be dealt with. 462 ;; sure how it should actually be dealt with.
461 (if fn 463 (if fn
462 (set-face-font face fn locale nil 'append)) 464 (set-face-font face fn locale nil append))
463 ;; Kludge-o-rooni. Set the foreground and background resources for 465 ;; Kludge-o-rooni. Set the foreground and background resources for
464 ;; X devices only -- otherwise things tend to get all messed up 466 ;; X devices only -- otherwise things tend to get all messed up
465 ;; if you start up an X frame and then later create a TTY frame. 467 ;; if you start up an X frame and then later create a TTY frame.
466 (if fg 468 (if fg
467 (set-face-foreground face fg locale 'x 'append)) 469 (set-face-foreground face fg locale 'x append))
468 (if bg 470 (if bg
469 (set-face-background face bg locale 'x 'append)) 471 (set-face-background face bg locale 'x append))
470 (if bgp 472 (if bgp
471 (set-face-background-pixmap face bgp locale nil 'append)) 473 (set-face-background-pixmap face bgp locale nil append))
472 (if ulp 474 (if ulp
473 (set-face-underline-p face ulp locale nil 'append)) 475 (set-face-underline-p face ulp locale nil append))
474 (if stp 476 (if stp
475 (set-face-strikethru-p face stp locale nil 'append)) 477 (set-face-strikethru-p face stp locale nil append))
476 (if hp 478 (if hp
477 (set-face-highlight-p face hp locale nil 'append)) 479 (set-face-highlight-p face hp locale nil append))
478 (if dp 480 (if dp
479 (set-face-dim-p face dp locale nil 'append)) 481 (set-face-dim-p face dp locale nil append))
480 (if bp 482 (if bp
481 (set-face-blinking-p face bp locale nil 'append)) 483 (set-face-blinking-p face bp locale nil append))
482 (if rp 484 (if rp
483 (set-face-reverse-p face rp locale nil 'append)) 485 (set-face-reverse-p face rp locale nil append))
484 )) 486 ))
487
488 ;; GNU Emacs compatibility. (move to obsolete.el?)
489 (defalias 'make-face-x-resource-internal 'x-init-face-from-resources)
485 490
486 ;;; x-init-global-faces is responsible for ensuring that the 491 ;;; x-init-global-faces is responsible for ensuring that the
487 ;;; default face has some reasonable fallbacks if nothing else is 492 ;;; default face has some reasonable fallbacks if nothing else is
488 ;;; specified. 493 ;;; specified.
489 ;;; 494 ;;;