Mercurial > hg > xemacs-beta

comparison lisp/prim/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
1067 "Return whether FACE is proportional. 1067 "Return whether FACE is proportional.
1068 See `face-property-instance' for the semantics of the DOMAIN argument." 1068 See `face-property-instance' for the semantics of the DOMAIN argument."
1069 (font-proportional-p (face-font face) domain charset)) 1069 (font-proportional-p (face-font face) domain charset))
1070 1070
1071 1071
1072 (defvar init-face-from-resources t
1073 "If non-nil, attempt to initialize faces from the reseource database.")
1074
1075 (defun make-empty-face (name &optional doc-string temporary)
1076 "Like `make-face', but doesn't query the reseource database."
1077 (let ((init-face-from-resources nil))
1078 (make-face name doc-string temporary)))
1079
1072 (defun init-face-from-resources (face &optional locale) 1080 (defun init-face-from-resources (face &optional locale)
1073 "Initialize FACE from the resource database. 1081 "Initialize FACE from the resource database.
1074 If LOCALE is specified, it should be a frame, device, or 'global, and 1082 If LOCALE is specified, it should be a frame, device, or 'global, and
1075 the face will be resourced over that locale. Otherwise, the face will 1083 the face will be resourced over that locale. Otherwise, the face will
1076 be resourced over all possible locales (i.e. all frames, all devices, 1084 be resourced over all possible locales (i.e. all frames, all devices,
1077 and 'global)." 1085 and 'global)."
1078 (if (not locale) 1086 (cond ((null init-face-from-resources)
1079 (progn 1087 ;; Do nothing.
1080 (init-face-from-resources face 'global) 1088 )
1081 (let ((devices (device-list))) 1089 ((not locale)
1082 (while devices 1090 ;; Global, set for all frames.
1083 (init-face-from-resources face (car devices)) 1091 (progn
1084 (setq devices (cdr devices)))) 1092 (init-face-from-resources face 'global)
1085 (let ((frames (frame-list))) 1093 (let ((devices (device-list)))
1086 (while frames 1094 (while devices
1087 (init-face-from-resources face (car frames)) 1095 (init-face-from-resources face (car devices))
1088 (setq frames (cdr frames))))) 1096 (setq devices (cdr devices))))
1089 (let ((devtype (cond ((devicep locale) (device-type locale)) 1097 (let ((frames (frame-list)))
1090 ((framep locale) (frame-type locale)) 1098 (while frames
1091 (t nil)))) 1099 (init-face-from-resources face (car frames))
1092 (cond ((or (and (not devtype) (featurep 'x)) (eq 'x devtype)) 1100 (setq frames (cdr frames))))))
1093 (x-init-face-from-resources face locale)) 1101 (t
1094 ((or (not devtype) (eq 'tty devtype)) 1102 ;; Specific.
1095 ;; Nothing to do for TTYs? 1103 (let ((devtype (cond ((devicep locale) (device-type locale))
1096 ))))) 1104 ((framep locale) (frame-type locale))
1105 (t nil))))
1106 (cond ((or (and (not devtype) (featurep 'x)) (eq 'x devtype))
1107 (x-init-face-from-resources face locale))
1108 ((or (not devtype) (eq 'tty devtype))
1109 ;; Nothing to do for TTYs?
1110 ))))))
1097 1111
1098 (defun init-device-faces (device) 1112 (defun init-device-faces (device)
1099 ;; First, add any device-local face resources. 1113 ;; First, add any device-local face resources.
1100 (let ((faces (face-list))) 1114 (when init-face-from-resources
1101 (while faces 1115 (loop for face in (face-list) do
1102 (init-face-from-resources (car faces) device) 1116 (init-face-from-resources face device))
1103 (setq faces (cdr faces)))) 1117 ;; Then do any device-specific initialization.
1104 ;; Then do any device-specific initialization. 1118 (cond ((eq 'x (device-type device))
1105 (cond ((eq 'x (device-type device)) 1119 (x-init-device-faces device))
1106 (x-init-device-faces device)) 1120 ;; Nothing to do for TTYs?
1107 ;; Nothing to do for TTYs? 1121 )
1108 ) 1122 (init-other-random-faces device)))
1109 (init-other-random-faces device))
1110 1123
1111 (defun init-frame-faces (frame) 1124 (defun init-frame-faces (frame)
1112 ;; First, add any frame-local face resources. 1125 (when init-face-from-resources
1113 (let ((faces (face-list))) 1126 ;; First, add any frame-local face resources.
1114 (while faces 1127 (loop for face in (face-list) do
1115 (init-face-from-resources (car faces) frame) 1128 (init-face-from-resources face frame))
1116 (setq faces (cdr faces)))) 1129 ;; Then do any frame-specific initialization.
1117 ;; Then do any frame-specific initialization. 1130 (cond ((eq 'x (frame-type frame))
1118 (cond ((eq 'x (frame-type frame)) 1131 (x-init-frame-faces frame))
1119 (x-init-frame-faces frame)) 1132 ;; Is there anything which should be done for TTY's?
1120 ;; Is there anything which should be done for TTY's? 1133 )))
1121 ))
1122 1134
1123 ;; #### This is somewhat X-specific, and is called when the first 1135 ;; #### This is somewhat X-specific, and is called when the first
1124 ;; X device is created (even if there were TTY devices created 1136 ;; X device is created (even if there were TTY devices created
1125 ;; beforehand). The concept of resources has not been generalized 1137 ;; beforehand). The concept of resources has not been generalized
1126 ;; outside of X-specificness, so we have to live with this 1138 ;; outside of X-specificness, so we have to live with this