Mercurial > hg > xemacs-beta
diff lisp/prim/faces.el @ 70:131b0175ea99 r20-0b30
Import from CVS: tag r20-0b30
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:02:59 +0200 |
parents | ec9a17fef872 |
children | c7528f8e288d |
line wrap: on
line diff
--- a/lisp/prim/faces.el Mon Aug 13 09:00:04 2007 +0200 +++ b/lisp/prim/faces.el Mon Aug 13 09:02:59 2007 +0200 @@ -31,7 +31,7 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the +;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. @@ -1069,68 +1069,56 @@ (font-proportional-p (face-font face) domain charset)) -(defvar init-face-from-resources t - "If non-nil, attempt to initialize faces from the resource database.") - -(defun make-empty-face (name &optional doc-string temporary) - "Like `make-face', but doesn't query the resource database." - (let ((init-face-from-resources nil)) - (make-face name doc-string temporary))) - (defun init-face-from-resources (face &optional locale) "Initialize FACE from the resource database. If LOCALE is specified, it should be a frame, device, or 'global, and the face will be resourced over that locale. Otherwise, the face will be resourced over all possible locales (i.e. all frames, all devices, and 'global)." - (cond ((null init-face-from-resources) - ;; Do nothing. - ) - ((not locale) - ;; Global, set for all frames. - (progn - (init-face-from-resources face 'global) - (let ((devices (device-list))) - (while devices - (init-face-from-resources face (car devices)) - (setq devices (cdr devices)))) - (let ((frames (frame-list))) - (while frames - (init-face-from-resources face (car frames)) - (setq frames (cdr frames)))))) - (t - ;; Specific. - (let ((devtype (cond ((devicep locale) (device-type locale)) - ((framep locale) (frame-type locale)) - (t nil)))) - (cond ((or (and (not devtype) (featurep 'x)) (eq 'x devtype)) - (x-init-face-from-resources face locale)) - ((or (not devtype) (eq 'tty devtype)) - ;; Nothing to do for TTYs? - )))))) + (if (not locale) + (progn + (init-face-from-resources face 'global) + (let ((devices (device-list))) + (while devices + (init-face-from-resources face (car devices)) + (setq devices (cdr devices)))) + (let ((frames (frame-list))) + (while frames + (init-face-from-resources face (car frames)) + (setq frames (cdr frames))))) + (let ((devtype (cond ((devicep locale) (device-type locale)) + ((framep locale) (frame-type locale)) + (t nil)))) + (cond ((or (and (not devtype) (featurep 'x)) (eq 'x devtype)) + (x-init-face-from-resources face locale)) + ((or (not devtype) (eq 'tty devtype)) + ;; Nothing to do for TTYs? + ))))) (defun init-device-faces (device) ;; First, add any device-local face resources. - (when init-face-from-resources - (loop for face in (face-list) do - (init-face-from-resources face device)) - ;; Then do any device-specific initialization. - (cond ((eq 'x (device-type device)) - (x-init-device-faces device)) - ;; Nothing to do for TTYs? - ) - (init-other-random-faces device))) + (let ((faces (face-list))) + (while faces + (init-face-from-resources (car faces) device) + (setq faces (cdr faces)))) + ;; Then do any device-specific initialization. + (cond ((eq 'x (device-type device)) + (x-init-device-faces device)) + ;; Nothing to do for TTYs? + ) + (init-other-random-faces device)) (defun init-frame-faces (frame) - (when init-face-from-resources - ;; First, add any frame-local face resources. - (loop for face in (face-list) do - (init-face-from-resources face frame)) - ;; Then do any frame-specific initialization. - (cond ((eq 'x (frame-type frame)) - (x-init-frame-faces frame)) - ;; Is there anything which should be done for TTY's? - ))) + ;; First, add any frame-local face resources. + (let ((faces (face-list))) + (while faces + (init-face-from-resources (car faces) frame) + (setq faces (cdr faces)))) + ;; Then do any frame-specific initialization. + (cond ((eq 'x (frame-type frame)) + (x-init-frame-faces frame)) + ;; Is there anything which should be done for TTY's? + )) ;; #### This is somewhat X-specific, and is called when the first ;; X device is created (even if there were TTY devices created @@ -1228,7 +1216,7 @@ ;; similar for bold-italic. (or (face-differs-from-default-p 'bold-italic device) - (make-face-bold 'bold-italic device)) + (make-face-bold-italic 'bold-italic device)) ;; if we couldn't get a bold-italic version, try just bold. (or (face-differs-from-default-p 'bold-italic device) (make-face-bold-italic 'bold-italic device)) @@ -1282,10 +1270,11 @@ ;; first time through, set the zmacs-region color if it's not already ;; specified. - (unless (or (face-differs-from-default-p 'zmacs-region device) - (face-background 'zmacs-region 'global)) - (set-face-background 'zmacs-region "gray65" 'global 'color) - (set-face-background 'zmacs-region "gray65" 'global 'grayscale)) + (if (and (not (face-differs-from-default-p 'zmacs-region device)) + (not (face-background 'zmacs-region 'global))) + (progn + (set-face-background 'zmacs-region "gray" 'global 'color) + (set-face-background 'zmacs-region "gray80" 'global 'grayscale))) (if (and (not (face-differs-from-default-p 'zmacs-region device)) (not (face-background-pixmap 'zmacs-region 'global))) (progn @@ -1318,10 +1307,11 @@ ;; first time through, set the primary-selection color if it's not already ;; specified. - (unless (or (face-differs-from-default-p 'primary-selection device) - (face-background 'primary-selection 'global)) - (set-face-background 'primary-selection "gray65" 'global 'color) - (set-face-background 'primary-selection "gray65" 'global 'grayscale)) + (if (and (not (face-differs-from-default-p 'primary-selection device)) + (not (face-background 'primary-selection 'global))) + (progn + (set-face-background 'primary-selection "gray" 'global 'color) + (set-face-background 'primary-selection "gray80" 'global 'grayscale))) (if (and (not (face-differs-from-default-p 'secondary-selection device)) (not (face-background-pixmap 'primary-selection 'global))) (set-face-background-pixmap 'primary-selection "gray3" 'global 'mono)) @@ -1370,7 +1360,7 @@ (font (face-font 'modeline-buffer-id 'global))) (and (featurep 'x) (or fg - (set-face-foreground 'modeline-buffer-id "blue4" 'global + (set-face-foreground 'modeline-buffer-id "blue" 'global '(color x)))) (if font nil @@ -1379,8 +1369,7 @@ (set-face-font 'modeline-buffer-id [bold-italic] nil '(mono x)) (set-face-font 'modeline-buffer-id [bold-italic] nil '(grayscale x)))) - (if (featurep 'tty) - (set-face-font 'modeline-buffer-id [bold-italic] nil 'tty))))) + (set-face-font 'modeline-buffer-id [bold-italic] nil 'tty)))) (set-face-parent 'modeline-buffer-id 'modeline nil nil 'append) ;; modeline-mousable: @@ -1389,7 +1378,7 @@ (font (face-font 'modeline-mousable 'global))) (and (featurep 'x) (or fg - (set-face-foreground 'modeline-mousable "firebrick" 'global + (set-face-foreground 'modeline-mousable "red" 'global '(color x)))) (if font nil @@ -1407,8 +1396,7 @@ (or fg (set-face-foreground 'modeline-mousable-minor-mode '(((color x) . "green4") - ((color x) . "forestgreen")) - 'global))))) + ((color x) . "green")) 'global))))) (set-face-parent 'modeline-mousable-minor-mode 'modeline-mousable nil nil 'append) ) @@ -1480,5 +1468,3 @@ ;; (if (featurep 'tty) (set-face-reverse-p 'isearch t 'global 'tty)) - -;;; faces.el ends here