xemacs-beta: lisp/x-faces.el comparison

comparison lisp/x-faces.el @ 4822:0482cdb4e35d

Cosmetic changes in x-faces.e

author	Didier Verna <didier@lrde.epita.fr>
date	Sun, 10 Jan 2010 10:25:57 +0100
parents	49480d838d32
children	8b2f75cecb89

comparison

equal deleted inserted replaced

-:49480d838d32
+:0482cdb4e35d
 x-color-list-internal-cache)))
 ;;; internal routines
-;;; x-init-face-from-resources is responsible for initializing a
+;;; x-init-face-from-resources is responsible for initializing a newly-created
-;;; newly-created face from the resource database.
+;;; face from the resource database.
 ;;;
-;;; When a new frame is created, it is called from `x-init-frame-faces'
+;;; When a new frame is created, it is called from `x-init-frame-faces' called
-;;; called from `init-frame-faces' called from init_frame_faces()
+;;; from `init-frame-faces' called from init_frame_faces() from Fmake_frame().
-;;; from Fmake_frame().  In this case it is called once for each existing
+;;; In this case it is called once for each existing face, with the
-;;; face, with the newly-created frame as the argument.  It then initializes
+;;; newly-created frame as the argument. It then initializes the newly-created
-;;; the newly-created faces on that frame.
+;;; faces on that frame.
 ;;;
-;;; It's also called from `init-device-faces' and
+;;; It's also called from `init-device-faces' and `init-global-faces'.
-;;; `init-global-faces'.
 ;;;
-;;; This had better not signal an error.  The frame is in an intermediate
+;;; This had better not signal an error. The frame is in an intermediate state
-;;; state where signalling an error or entering the debugger would likely
+;;; where signalling an error or entering the debugger would likely result in
-;;; result in a crash.
+;;; a crash.
-;; When we initialise a face from an X resource, note that we did so.
+;; When we initialise a face from an X resource, note that we did so. Now in
-;;
+;; specifier.el so run-time checks for it on non-X builds don't error.
-;; Now in specifier.el so run-time checks for it on non-X builds don't
+;; (define-specifier-tag 'x-resource)
-;; error.
-; (define-specifier-tag 'x-resource)
 (defun x-init-face-from-resources (face &optional locale set-anyway)
-;;
 ;; These are things like "attributeForeground" instead of simply
-;; "foreground" because people tend to do things like "*foreground",
+;; "foreground" because people tend to do things like "*foreground", which
-;; which would cause all faces to be fully qualified, making faces
+;; would cause all faces to be fully qualified, making faces inherit
-;; inherit attributes in a non-useful way.  So we've made them slightly
+;; attributes in a non-useful way. So we've made them slightly less obvious
-;; less obvious to specify in order to make them work correctly in
+;; to specify in order to make them work correctly in more random
-;; more random environments.
+;; environments.
-;;
 ;; I think these should be called "face.faceForeground" instead of
-;; "face.attributeForeground", but they're the way they are for
+;; "face.attributeForeground", but they're the way they are for hysterical
-;; hysterical reasons. (jwz)
+;; reasons. (jwz)
 (let* ((append (if set-anyway nil 'append))
-	 ;; Some faces are initialized before XEmacs is dumped.
+	 ;; Some faces are initialized before XEmacs is dumped. In order for
-	 ;; In order for the X resources to be able to override
+	 ;; the X resources to be able to override those settings, such
-	 ;; those settings, such initialization always uses the
+	 ;; initialization always uses the `default' tag. We remove all
-	 ;; `default' tag.  We remove all specifier specs
+	 ;; specifier specs containing the `default' tag in the locale before
-	 ;; containing the `default' tag in the locale before
 	 ;; adding new specs.
 	 (tag-set '(default))
-	 ;; The tag order matters here.  The spec removal
+	 ;; The tag order matters here. The spec removal function uses the
-	 ;; function uses the list cdrs.  We want to remove (x
+	 ;; list cdrs. We want to remove (x default) and (default) specs, not
-	 ;; default) and (default) specs, not (default x) and (x)
+	 ;; (default x) and (x) specs.
-	 ;; specs.
 	 (x-tag-set '(x default))
 	 (tty-tag-set '(tty default))
 (our-tag-set '(x x-resource))
 	 (device-class nil)
 	 (face-sym (face-name face))
 	       'boolean locale))
 	 (stp (x-get-resource-and-maybe-bogosity-check
 	       (concat name ".attributeStrikethru")
 	       "Face.AttributeStrikethru"
 	       'boolean locale))
-	 ;; we still resource for these TTY-only resources so that
+	 ;; we still resource for these TTY-only resources so that you can
-	 ;; you can specify resources for TTY frames/devices.  This is
+	 ;; specify resources for TTY frames/devices. This is useful when you
-	 ;; useful when you start up your XEmacs on an X display and later
+	 ;; start up your XEmacs on an X display and later open some TTY
-	 ;; open some TTY frames.
+	 ;; frames.
 	 (hp (x-get-resource-and-maybe-bogosity-check
 	      (concat name ".attributeHighlight")
 	      "Face.AttributeHighlight"
 	      'boolean locale))
 	 (dp (x-get-resource-and-maybe-bogosity-check
 	(setq tag-set (cons device-class tag-set)
 	      x-tag-set (cons device-class x-tag-set)
 	      tty-tag-set (cons device-class tty-tag-set)
 our-tag-set (cons device-class our-tag-set)))
-;;
+;; For the default and gui-element faces, some unspecified properties
-;; If this is the default face, then any unspecified properties should
+;; should be defaulted from the global properties. Can't do this for
-;; be defaulted from the global properties.  Can't do this for
 ;; frames or devices because then, common resource specs like
 ;; "*Foreground: black" will have unwanted effects.
-;;
 (if (and (or (eq (face-name face) 'default)
 		 (eq (face-name face) 'gui-element))
 	     (or (null locale) (eq locale 'global)))
 	(progn
 	  (or fn (setq fn (x-get-resource
 			   "foreground" "Foreground" 'string locale nil
 			   'warn)))
 	  (or bg (setq bg (x-get-resource
 			   "background" "Background" 'string locale nil
 			   'warn)))))
-;;
 ;; "*cursorColor: foo" is equivalent to setting the background of the
 ;; text-cursor face.
-;;
 (if (and (eq (face-name face) 'text-cursor)
 	     (or (null locale) (eq locale 'global)))
 	(setq bg (or (x-get-resource
 		      "cursorColor" "CursorColor" 'string locale nil 'warn)
 		     bg)))
-;; #### should issue warnings?  I think this should be
+;; #### NOTE: should issue warnings? I think this should be done when the
-;; done when the instancing actually happens, but I'm not
+;; instancing actually happens, but I'm not sure how it should actually be
-;; sure how it should actually be dealt with.
+;; dealt with.
 (when fn
 (if device-class
-	  ;; Always use the x-tag-set to remove specs, since we don't
+	  ;; Always use the x-tag-set to remove specs, since we don't know
-	  ;; know whether the predumped face was initialized with an
+	  ;; whether the predumped face was initialized with an 'x tag or not.
-	  ;; 'x tag or not.
 	  (remove-specifier-specs-matching-tag-set-cdrs (face-font face)
 							locale
 							x-tag-set)
-	;; If there's no device class then we're initializing
+	;; If there's no device class then we're initializing globally. This
-	;; globally.  This means we should override global
+	;; means we should override global defaults for all X device classes.
-	;; defaults for all X device classes.
 	(remove-specifier (face-font face) locale x-tag-set nil))
 (set-face-font face fn locale our-tag-set append)
-;; And retain some of the fallbacks in the generated default face,
+;; And retain some of the fallbacks in the generated default face, since
-;; since we don't want to try andale-mono's ISO-10646-1 encoding for
+;; we don't want to try andale-mono's ISO-10646-1 encoding for Amharic
-;; Amharic or Thai.
+;; or Thai.
 (when (and (specifierp (face-font face))
 (consp (specifier-fallback (face-font face))))
 (loop
 for (tag-set . instantiator)
 in (specifier-fallback (face-font face))
 (face-font face)
 (list (cons (or locale 'global)
 (list (cons tag-set instantiator))))
 append))))
-;; Kludge-o-rooni.  Set the foreground and background resources for
+;; Kludge-o-rooni. Set the foreground and background resources for X
-;; X devices only -- otherwise things tend to get all messed up
+;; devices only -- otherwise things tend to get all messed up if you start
-;; if you start up an X frame and then later create a TTY frame.
+;; up an X frame and then later create a TTY frame.
 (when fg
 (if device-class
 	  (remove-specifier-specs-matching-tag-set-cdrs (face-foreground face)
 							locale
 							x-tag-set)
 (defun remove-specifier-specs-matching-tag-set-cdrs (specifier locale tag-set)
 (while tag-set
 (remove-specifier specifier locale tag-set t)
 (setq tag-set (cdr tag-set))))
-;;; x-init-global-faces is responsible for ensuring that the
+;;; x-init-global-faces is responsible for ensuring that the default face has
-;;; default face has some reasonable fallbacks if nothing else is
+;;; some reasonable fallbacks if nothing else is specified.
-;;; specified.
-;;;
 (defun x-init-global-faces ()
 ;; #### NOTE: this code is probably an oldy: faces.c ensures that we have
 ;; working fallback values so there is no need to initialize anything here.
 ;; -- dvl
 ;;   (or (face-foreground 'default 'global)
 ;;       (set-face-foreground 'default "black" 'global '(x default)))
 ;;   (or (face-background 'default 'global)
 ;;       (set-face-background 'default "gray80" 'global '(x default))
 )
-;;; x-init-device-faces is responsible for initializing default
+;;; x-init-device-faces is responsible for initializing default values for
-;;; values for faces on a newly created device.
+;;; faces on a newly created device.
-;;;
 (defun x-init-device-faces (device)
-;;
 ;; If the "default" face didn't have a font specified, try to pick one.
-;;
 ;; (or
 ;; (face-font-instance 'default device)
-;;
 ;; [[ No font specified in the resource database; try to cope. ]]
-;;
-;; NOTE: In reality, this will never happen.  The fallbacks will always
+;; #### NOTE: In reality, this will never happen. The fallbacks will always
-;; be tried, and the last fallback is "*", which should get any font.  No
+;; be tried, and the last fallback is "*", which should get any font. No
-;; need to put the same checks here as in the fallbacks.  These comments
+;; need to put the same checks here as in the fallbacks. These comments
 ;; appear to be pre-19.12. --ben
 ;; [[ At first I wanted to do this by just putting a font-spec in the
-;; fallback resources passed to XtAppInitialize(), but that fails
+;; fallback resources passed to XtAppInitialize(), but that fails if there
-;; if there is an Emacs app-defaults file which doesn't specify a
+;; is an Emacs app-defaults file which doesn't specify a font: apparently
-;; font: apparently the fallback resources are not consulted when
+;; the fallback resources are not consulted when there is an app-defaults
-;; there is an app-defaults file, which seems pretty bogus to me.
+;; file, which seems pretty bogus to me.
-;;
-;; We should also probably try "*xtDefaultFont", but I think that it
+;; We should also probably try "*xtDefaultFont", but I think that it might
-;; might be legal to specify that as "xtDefaultFont:", that is, at
+;; be legal to specify that as "xtDefaultFont:", that is, at top level,
-;; top level, instead of "*xtDefaultFont:", that is, applicable to
+;; instead of "*xtDefaultFont:", that is, applicable to every application.
-;; every application.  `x-get-resource' can't handle that right now.
+;; `x-get-resource' can't handle that right now. Anyway, xtDefaultFont is
-;; Anyway, xtDefaultFont is probably variable-width.
+;; probably variable-width.
-;;
-;; Some who have LucidaTypewriter think it's a better font than Courier,
+;; Some who have LucidaTypewriter think it's a better font than Courier, but
-;; but it has the bug that there are no italic and bold italic versions.
+;; it has the bug that there are no italic and bold italic versions. We
-;; We could hair this code up to try and mix-and-match fonts to get a
+;; could hair this code up to try and mix-and-match fonts to get a full
-;; full complement, but really, why bother.  It's just a default. ]]
+;; complement, but really, why bother. It's just a default. ]]
-;;
-;; [[ We default to looking for iso8859 fonts.  Using a wildcard for the
+;; [[ We default to looking for iso8859 fonts. Using a wildcard for the
 ;; encoding would be bad, because that can cause English speakers to get
-;; Kanji fonts by default.  It is safe to assume that people using a
+;; Kanji fonts by default. It is safe to assume that people using a language
-;; language other than English have both set $LANG, and have specified
+;; other than English have both set $LANG, and have specified their `font'
-;; their `font' and `fontList' resources.  In any event, it's better to
+;; and `fontList' resources. In any event, it's better to err on the side of
-;; err on the side of the English speaker in this case because they are
+;; the English speaker in this case because they are much less likely to
-;; much less likely to have encountered this problem, and are thus less
+;; have encountered this problem, and are thus less likely to know what to
-;; likely to know what to do about it. ]]
+;; do about it. ]]
 ;; #### NOTE: this code is probably an oldy as well (as per Ben's comment
 ;; above): faces.c ensures that we have working fallback values so there is
 ;; no need to initialize anything here. -- dvl
 ;;	      (or fg (set-face-foreground 'default "white" device))
 ;;	      (or bg (set-face-background 'default "black" device)))
 ;;	  (or fg (set-face-foreground 'default "white" device))
 ;;	  (or bg (set-face-background 'default "black" device)))))
-;; Don't look at reverseVideo now or initialize the modeline.  This
+;; Don't look at reverseVideo now or initialize the modeline. This is done
-;; is done on a per-frame basis at the appropriate time.
+;; on a per-frame basis at the appropriate time.
-;;
+;; Now let's try to pick some reasonable defaults for a few other faces.
-;; Now let's try to pick some reasonable defaults for a few other faces.
+;; This kind of stuff should normally go on the create-frame-hook, but this
-;; This kind of stuff should normally go on the create-frame-hook, but
+;; way we won't be in danger of the user screwing things up by not adding
-;; this way we won't be in danger of the user screwing things up by not
+;; hooks in a safe way.
-;; adding hooks in a safe way.
-;;
 (x-init-pointer-shape device)  ; from x-mouse.el
 )
 ;;; This is called from `init-frame-faces', which is called from
-;;; init_frame_faces() which is called from Fmake_frame(), to perform
+;;; init_frame_faces() which is called from Fmake_frame(), to perform any
-;;; any device-specific initialization.
+;;; device-specific initialization.
-;;;
 (defun x-init-frame-faces (frame)
-;;
+;; The faces already got initialized (by init-frame-faces) from the resource
-;; The faces already got initialized (by init-frame-faces) from
+;; database or global, non-frame faces. The default, bold, bold-italic, and
-;; the resource database or global, non-frame faces.  The default,
+;; italic faces (plus various other random faces) got set up then. But
-;; bold, bold-italic, and italic faces (plus various other random faces)
+;; modeline didn't so that reverseVideo can be frame-specific.
-;; got set up then.  But modeline didn't so that reverseVideo can be
-;; frame-specific.
+;; If reverseVideo was specified, swap the foreground and background of the
-;;
+;; default and modeline faces.
-;;
-;; If reverseVideo was specified, swap the foreground and background
-;; of the default and modeline faces.
-;;
 (cond ((car (x-get-resource "reverseVideo" "ReverseVideo" 'boolean frame
 			      nil 'warn))
 	 ;; #### NOTE: again, this is probably yet another oldy: faces.c
 	 ;; ensures sane fallbacks for the modeline face. Besides, this face
 	 ;; does not inherit from the default face, but from the gui-element
 	 ;;	 (or (face-background 'modeline frame)
 	 ;;	     (set-face-background 'modeline
 	 ;;				  (face-background-instance 'default frame)
 	 ;;				  frame))
-	 ;; Now invert both of them.  If they end up looking the same,
+	 ;; Now invert both of them. If they end up looking the same,
 	 ;; make-frame-initial-faces will invert the modeline again later.
 	 (invert-face 'default frame)
 	 (invert-face 'modeline frame)
 	 )))

Mercurial > hg > xemacs-beta

comparison lisp/x-faces.el @ 4822:0482cdb4e35d