changeset 711:5be46355cc42

[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 a00780ef853d
children 2d3184c89f71
files lisp/ChangeLog lisp/faces.el lisp/gtk-faces.el lisp/gui.el
diffstat 4 files changed, 72 insertions(+), 87 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sat Dec 22 07:20:58 2001 +0000
+++ b/lisp/ChangeLog	Sun Dec 23 01:01:46 2001 +0000
@@ -11,6 +11,30 @@
 	* package-get.el (package-get-update-all): Make sure installed.db
 	gets updated after updating packages.
 
+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.
+
 2001-12-11  Andy Piper  <andy@xemacs.org>
 
 	* menubar.el (get-popup-menu-response): re-order so that it works
--- a/lisp/faces.el	Sat Dec 22 07:20:58 2001 +0000
+++ b/lisp/faces.el	Sun Dec 23 01:01:46 2001 +0000
@@ -1812,96 +1812,62 @@
 ;; the first non-stream device.
 
 (set-face-background 'text-cursor
-		     '(((x default) . "Red3")
-		       ((mswindows default) . "Red3"))
+		     '(((win default) . "Red3"))
 		     'global)
 
 ;; some older X servers don't recognize "darkseagreen2"
 (set-face-background 'highlight
-		     '(((x default color) . "darkseagreen2")
-		       ((x default color) . "green")
-		       ((x default grayscale) . "gray53")
-		       ((mswindows default color) . "darkseagreen2")
-		       ((mswindows default color) . "green")
-		       ((mswindows default grayscale) . "gray53"))
+		     '(((win default color) . "darkseagreen2")
+		       ((win default color) . "green")
+		       ((win default grayscale) . "gray53"))
 		     'global)
 (set-face-background-pixmap 'highlight
-			    '(((x default mono) . "gray1")
-;; 			      ((gtk default mono) . "gray1")
-			      ((mswindows default mono) . "gray1"))
+			    '(((win default mono) . "gray1"))
 			    'global)
 
 (set-face-background 'zmacs-region
-		     '(((x default color) . "gray65")
-		       ((x default grayscale) . "gray65")
-		       ((mswindows default color) . "gray65")
-		       ((mswindows default grayscale) . "gray65"))
+		     '(((win default color) . "gray65")
+		       ((win default grayscale) . "gray65"))
 		     'global)
 (set-face-background-pixmap 'zmacs-region
-			    '(((x default mono) . "gray3")
-;; 			      ((gtk default mono) . "gray3")
-			      ((mswindows default mono) . "gray3"))
+			    '(((win default mono) . "gray3"))
 			    'global)
 
 (set-face-background 'list-mode-item-selected
-		     '(((x default color) . "gray68")
-		       ((x default grayscale) . "gray68")
-		       ((x default mono) . [default foreground])
-;; 		       ((gtk default color) . "gray68")
-;; 		       ((gtk default grayscale) . "gray68")
-;; 		       ((gtk default mono) . [default foreground])
-		       ((mswindows default color) . "gray68")
-		       ((mswindows default grayscale) . "gray68")
-		       ((mswindows default mono) . [default foreground]))
+		     '(((win default color) . "gray68")
+		       ((win default grayscale) . "gray68")
+		       ((win default mono) . [default foreground]))
 		     'global)
 (set-face-foreground 'list-mode-item-selected
-		     '(((x default mono) . [default background])
-		       ((mswindows default mono) . [default background]))
+		     '(((win default mono) . [default background]))
 		     'global)
 
 (set-face-background 'primary-selection
-		     '(((x default color) . "gray65")
-		       ((x default grayscale) . "gray65")
-		       ((mswindows default color) . "gray65")
-		       ((mswindows default grayscale) . "gray65"))
+		     '(((win default color) . "gray65")
+		       ((win default grayscale) . "gray65"))
 		     'global)
 (set-face-background-pixmap 'primary-selection
-			    '(((x default mono) . "gray3")
-			      ;;((gtk default mono) . "gray3")
-			      ((mswindows default mono) . "gray3"))
+			    '(((win default mono) . "gray3"))
 			    'global)
 
 (set-face-background 'secondary-selection
-		     '(((x default color) . "paleturquoise")
-		       ((x default color) . "green")
-		       ((x default grayscale) . "gray53")
-		       ;;((gtk default color) . "paleturquoise")
-		       ;;((gtk default color) . "green")
-		       ;;((gtk default grayscale) . "gray53")
-		       ((mswindows default color) . "paleturquoise")
-		       ((mswindows default color) . "green")
-		       ((mswindows default grayscale) . "gray53"))
+		     '(((win default color) . "paleturquoise")
+		       ((win default color) . "green")
+		       ((win default grayscale) . "gray53"))
 		     'global)
 (set-face-background-pixmap 'secondary-selection
-			    '(((x default mono) . "gray1")
-			      ;;((gtk default mono) . "gray1")
-			      ((mswindows default mono) . "gray1"))
+			    '(((win default mono) . "gray1"))
 			    'global)
 
 (set-face-background 'isearch
-		     '(((x default color) . "paleturquoise")
-		       ((x default color) . "green")
-		       ;;((gtk default color) . "paleturquoise")
-		       ;;((gtk default color) . "green")
-		       ((mswindows default color) . "paleturquoise")
-		       ((mswindows default color) . "green"))
+		     '(((win default color) . "paleturquoise")
+		       ((win default color) . "green"))
 		     'global)
 
 ;; #### This should really, I mean *really*, be converted to some form
 ;; of `defface' one day.
 (set-face-foreground 'isearch-secondary
-		     '(((x default color) . "red3")
-		       ((mswindows default color) . "red3"))
+		     '(((win default color) . "red3"))
 		     'global)
 
 ;; Define some logical color names to be used when reading the pixmap files.
--- a/lisp/gtk-faces.el	Sat Dec 22 07:20:58 2001 +0000
+++ b/lisp/gtk-faces.el	Sun Dec 23 01:01:46 2001 +0000
@@ -42,14 +42,10 @@
    gtk-font-selection-dialog-cancel-button gtk-widget-show-all
    gtk-main))
 
-(defun gtk-init-find-device ()
-  (let ((dev nil)
-	(devices (device-list)))
-    (while (and (not dev) devices)
-      (if (eq (device-type (car devices)) 'gtk)
-	  (setq dev (car devices)))
-      (setq devices (cdr devices)))
-    dev))
+(eval-when-compile
+  (defmacro gtk-style-munge-face (face attribute value)
+    (let ((func (intern (format "face-%s" (eval attribute)))))
+      `(add-spec-to-specifier (,func ,face) ,value nil '(gtk default) 'prepend))))
 
 ;;; gtk-init-device-faces is responsible for initializing default
 ;;; values for faces on a newly created device.
@@ -58,29 +54,30 @@
   ;;
   ;; If the "default" face didn't have a font specified, try to pick one.
   ;;
-  (if (not (eq (device-type device) 'gtk))
-      nil
-    (gtk-init-pointers)
+  (when (eq (device-type device) 'gtk)
     (let* ((style (gtk-style-info device))
-	   ;;(normal 0)			; GTK_STATE_NORMAL
+	   (normal 0)			; GTK_STATE_NORMAL
 	   ;;(active 1)			; GTK_STATE_ACTIVE
 	   (prelight 2)			; GTK_STATE_PRELIGHT
 	   (selected 3)			; GTK_STATE_SELECTED
 	   ;;(insensitive 4)		; GTK_STATE_INSENSITIVE
 	   )
-      (set-face-foreground 'highlight
-			   (nth prelight (plist-get style 'text))
-			   nil '(gtk default))
-      (set-face-background 'highlight
-			   (nth prelight (plist-get style 'background))
-			   nil '(gtk default))
-      (set-face-foreground 'zmacs-region
-			   (nth selected (plist-get style 'text))
-			   nil '(gtk default))
-      (set-face-background 'zmacs-region
-			   (nth selected (plist-get style 'background))
-			   nil '(gtk default)))
-    (set-face-background 'text-cursor "red3" device)))
+      (gtk-style-munge-face 'highlight 'foreground
+			    (nth prelight (plist-get style 'text)))
+      (gtk-style-munge-face 'highlight 'background
+			    (nth prelight (plist-get style 'background)))
+      (gtk-style-munge-face 'zmacs-region 'foreground
+			    (nth selected (plist-get style 'text)))
+      (gtk-style-munge-face 'zmacs-region 'background
+			    (nth selected (plist-get style 'background)))
+      (gtk-style-munge-face 'toolbar 'background
+			    (nth normal (plist-get style 'base)))
+      (gtk-style-munge-face 'toolbar 'foreground
+			    (nth normal (plist-get style 'text)))
+      (set-face-background 'modeline [toolbar background] '(gtk default))
+      (set-face-foreground 'modeline [toolbar foreground] '(gtk default))
+      )
+    (gtk-init-pointers)))
 
 ;;; This is called from `init-frame-faces', which is called from
 ;;; init_frame_faces() which is called from Fmake_frame(), to perform
@@ -94,9 +91,9 @@
 ;;; specified.
 ;;;
 (defun gtk-init-global-faces ()
-  (let* ((dev (gtk-init-find-device))
+  (let* ((dev nil)
 	 (default-font (or (face-font 'default 'global)
-			   ;(plist-get (gtk-style-info dev) 'font)
+			   ;;(plist-get (gtk-style-info dev) 'font)
 			   "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*"))
 	 (italic-font (or (gtk-make-font-italic default-font dev) default-font))
 	 (bold-font (or (gtk-make-font-bold default-font dev) default-font))
--- a/lisp/gui.el	Sat Dec 22 07:20:58 2001 +0000
+++ b/lisp/gui.el	Sun Dec 23 01:01:46 2001 +0000
@@ -89,10 +89,8 @@
 (if (not (face-differs-from-default-p 'gui-button-face))
     (progn
       (set-face-reverse-p 'gui-button-face t)
-      (set-face-background 'gui-button-face '(((x color) . "grey75")
-					      ((mswindows color) . "grey75")))
-      (set-face-foreground 'gui-button-face '(((x color) . "black")
-					      ((mswindows color) . "black")))))
+      (set-face-background 'gui-button-face '(((win color) . "grey75")))
+      (set-face-foreground 'gui-button-face '(((win color) . "black")))))
 
 
 (defun gui-button-action (instance action user-data)