Mercurial > hg > xemacs-beta

comparison lisp/gtk-faces.el @ 711:5be46355cc42

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2001-12-23 01:01:45 by wmperry] 2001-12-13 William M. Perry <wmperry@gnu.org> * gtk-faces.el (gtk-init-device-faces): Better way of munging the default faces from a style. Do not use 'device' as the locale when setting it, or it makes it very difficult for a user to override. Now munges highlight, zmacs-region, and toolbar from the appropriate information in the default GtkStyle for the device. * gui.el (gui-button-face): Ditto. * faces.el (text-cursor): (highlight): (zmacs-region): (list-mode-item-selected): (primary-selection): (secondary-selection): (isearch): (isearch-secondary): Condense old window-system specific settings into one specifier using the 'win default' tags. * dialog-gtk.el (popup-builtin-question-dialog): Deal gracefully with buttons of length 1, 2, and 3. Fixed yes-or-no-p lossage.
author wmperry
date Sun, 23 Dec 2001 01:01:46 +0000
parents a307f9a2021d
children 943eaba38521
comparison
equal deleted inserted replaced
710:a00780ef853d 711:5be46355cc42
40 gtk-font-selection-dialog-get-font-name gtk-widget-destroy 40 gtk-font-selection-dialog-get-font-name gtk-widget-destroy
41 font-menu-set-font font-family font-size 41 font-menu-set-font font-family font-size
42 gtk-font-selection-dialog-cancel-button gtk-widget-show-all 42 gtk-font-selection-dialog-cancel-button gtk-widget-show-all
43 gtk-main)) 43 gtk-main))
44 44
45 (defun gtk-init-find-device () 45 (eval-when-compile
46 (let ((dev nil) 46 (defmacro gtk-style-munge-face (face attribute value)
47 (devices (device-list))) 47 (let ((func (intern (format "face-%s" (eval attribute)))))
48 (while (and (not dev) devices) 48 `(add-spec-to-specifier (,func ,face) ,value nil '(gtk default) 'prepend))))
49 (if (eq (device-type (car devices)) 'gtk)
50 (setq dev (car devices)))
51 (setq devices (cdr devices)))
52 dev))
53 49
54 ;;; gtk-init-device-faces is responsible for initializing default 50 ;;; gtk-init-device-faces is responsible for initializing default
55 ;;; values for faces on a newly created device. 51 ;;; values for faces on a newly created device.
56 ;;; 52 ;;;
57 (defun gtk-init-device-faces (device) 53 (defun gtk-init-device-faces (device)
58 ;; 54 ;;
59 ;; If the "default" face didn't have a font specified, try to pick one. 55 ;; If the "default" face didn't have a font specified, try to pick one.
60 ;; 56 ;;
61 (if (not (eq (device-type device) 'gtk)) 57 (when (eq (device-type device) 'gtk)
62 nil
63 (gtk-init-pointers)
64 (let* ((style (gtk-style-info device)) 58 (let* ((style (gtk-style-info device))
65 ;;(normal 0) ; GTK_STATE_NORMAL 59 (normal 0) ; GTK_STATE_NORMAL
66 ;;(active 1) ; GTK_STATE_ACTIVE 60 ;;(active 1) ; GTK_STATE_ACTIVE
67 (prelight 2) ; GTK_STATE_PRELIGHT 61 (prelight 2) ; GTK_STATE_PRELIGHT
68 (selected 3) ; GTK_STATE_SELECTED 62 (selected 3) ; GTK_STATE_SELECTED
69 ;;(insensitive 4) ; GTK_STATE_INSENSITIVE 63 ;;(insensitive 4) ; GTK_STATE_INSENSITIVE
70 ) 64 )
71 (set-face-foreground 'highlight 65 (gtk-style-munge-face 'highlight 'foreground
72 (nth prelight (plist-get style 'text)) 66 (nth prelight (plist-get style 'text)))
73 nil '(gtk default)) 67 (gtk-style-munge-face 'highlight 'background
74 (set-face-background 'highlight 68 (nth prelight (plist-get style 'background)))
75 (nth prelight (plist-get style 'background)) 69 (gtk-style-munge-face 'zmacs-region 'foreground
76 nil '(gtk default)) 70 (nth selected (plist-get style 'text)))
77 (set-face-foreground 'zmacs-region 71 (gtk-style-munge-face 'zmacs-region 'background
78 (nth selected (plist-get style 'text)) 72 (nth selected (plist-get style 'background)))
79 nil '(gtk default)) 73 (gtk-style-munge-face 'toolbar 'background
80 (set-face-background 'zmacs-region 74 (nth normal (plist-get style 'base)))
81 (nth selected (plist-get style 'background)) 75 (gtk-style-munge-face 'toolbar 'foreground
82 nil '(gtk default))) 76 (nth normal (plist-get style 'text)))
83 (set-face-background 'text-cursor "red3" device))) 77 (set-face-background 'modeline [toolbar background] '(gtk default))
78 (set-face-foreground 'modeline [toolbar foreground] '(gtk default))
79 )
80 (gtk-init-pointers)))
84 81
85 ;;; This is called from `init-frame-faces', which is called from 82 ;;; This is called from `init-frame-faces', which is called from
86 ;;; init_frame_faces() which is called from Fmake_frame(), to perform 83 ;;; init_frame_faces() which is called from Fmake_frame(), to perform
87 ;;; any device-specific initialization. 84 ;;; any device-specific initialization.
88 ;;; 85 ;;;
92 ;;; gtk-init-global-faces is responsible for ensuring that the 89 ;;; gtk-init-global-faces is responsible for ensuring that the
93 ;;; default face has some reasonable fallbacks if nothing else is 90 ;;; default face has some reasonable fallbacks if nothing else is
94 ;;; specified. 91 ;;; specified.
95 ;;; 92 ;;;
96 (defun gtk-init-global-faces () 93 (defun gtk-init-global-faces ()
97 (let* ((dev (gtk-init-find-device)) 94 (let* ((dev nil)
98 (default-font (or (face-font 'default 'global) 95 (default-font (or (face-font 'default 'global)
99 ;(plist-get (gtk-style-info dev) 'font) 96 ;;(plist-get (gtk-style-info dev) 'font)
100 "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*")) 97 "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*"))
101 (italic-font (or (gtk-make-font-italic default-font dev) default-font)) 98 (italic-font (or (gtk-make-font-italic default-font dev) default-font))
102 (bold-font (or (gtk-make-font-bold default-font dev) default-font)) 99 (bold-font (or (gtk-make-font-bold default-font dev) default-font))
103 (bi-font (or (gtk-make-font-bold-italic default-font dev) default-font))) 100 (bi-font (or (gtk-make-font-bold-italic default-font dev) default-font)))
104 101