Mercurial > hg > xemacs-beta

comparison lisp/x11/x-faces.el @ 106:8ff55ebd4be9 r20-1b5

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