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