Mercurial > emacs

changeset 66336:d9a2701e02cd

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* cus-edit.el (custom-button, custom-button-pressed): New vars. (custom-raised-buttons): Add :set spec. (custom-button-unraised, custom-button-pressed-unraised): New faces, so that custom-raised-buttons actually does something. (custom-mode): Use custom-button and custom-button-pressed. * wid-edit.el (widget-specify-button): Don't ignore widget-mouse-face on graphic terminals. (widget-move-and-invoke): Cleanup.
author Chong Yidong <cyd@stupidchicken.com>
date Sun, 23 Oct 2005 17:40:38 +0000
parents 781c3e37424c
children 14837742f3d8
files lisp/ChangeLog lisp/cus-edit.el lisp/wid-edit.el
diffstat 3 files changed, 66 insertions(+), 16 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sun Oct 23 17:26:53 2005 +0000
+++ b/lisp/ChangeLog	Sun Oct 23 17:40:38 2005 +0000
@@ -1,3 +1,15 @@
+2005-10-23  Chong Yidong  <cyd@stupidchicken.com>
+
+	* cus-edit.el (custom-button, custom-button-pressed): New vars.
+	(custom-raised-buttons): Add :set spec.
+	(custom-button-unraised, custom-button-pressed-unraised): New
+	faces, so that custom-raised-buttons actually does something.
+	(custom-mode): Use custom-button and custom-button-pressed.
+
+	* wid-edit.el (widget-specify-button): Don't ignore
+	widget-mouse-face on graphic terminals.
+	(widget-move-and-invoke): Cleanup.
+
 2005-10-23  Thien-Thi Nguyen  <ttn@gnu.org>
 
 	* whitespace.el (whitespace-cleanup): Doc fix.
--- a/lisp/cus-edit.el	Sun Oct 23 17:26:53 2005 +0000
+++ b/lisp/cus-edit.el	Sun Oct 23 17:40:38 2005 +0000
@@ -1377,13 +1377,27 @@
   (interactive)
   (quit-window custom-buffer-done-kill))
 
+(defvar custom-button nil
+  "Face used for buttons in customization buffers.")
+
+(defvar custom-button-pressed nil
+  "Face used for pressed buttons in customization buffers.")
+
 (defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box)
 					     '(("unspecified" . unspecified))))
   "If non-nil, indicate active buttons in a `raised-button' style.
 Otherwise use brackets."
   :type 'boolean
   :version "21.1"
-  :group 'custom-buffer)
+  :group 'custom-buffer
+  :set (lambda (variable value)
+	 (custom-set-default variable value)
+	 (setq custom-button
+	       (if value 'custom-button 'custom-button-unraised))
+	 (setq custom-button-pressed
+	       (if value
+		   'custom-button-pressed
+		 'custom-button-pressed-unraised))))
 
 (defun custom-buffer-create-internal (options &optional description)
   (custom-mode)
@@ -1896,24 +1910,52 @@
 	   :background "lightgrey" :foreground "black"))
     (t
      nil))
-  "Face used for buttons in customization buffers."
+  "Face for custom buffer buttons if `custom-raised-buttons' is non-nil."
   :version "21.1"
   :group 'custom-faces)
 ;; backward-compatibility alias
 (put 'custom-button-face 'face-alias 'custom-button)
 
+(defface custom-button-unraised
+  '((((min-colors 88)
+      (class color) (background light)) :foreground "blue1" :underline t)
+    (((class color) (background light)) :foreground "blue" :underline t)
+    (((min-colors 88)
+      (class color) (background dark)) :foreground "cyan1" :underline t)
+    (((class color) (background dark)) :foreground "cyan" :underline t)
+    (t :underline t))
+  "Face for custom buffer buttons if `custom-raised-buttons' is nil."
+  :version "22.1"
+  :group 'custom-faces)
+
+(setq custom-button
+      (if custom-raised-buttons 'custom-button 'custom-button-unraised))
+
 (defface custom-button-pressed
   '((((type x w32 mac) (class color))
      (:box (:line-width 2 :style pressed-button)
 	   :background "lightgrey" :foreground "black"))
     (t
      (:inverse-video t)))
-  "Face used for buttons in customization buffers."
+  "Face for pressed custom buttons if `custom-raised-buttons' is non-nil."
   :version "21.1"
   :group 'custom-faces)
 ;; backward-compatibility alias
 (put 'custom-button-pressed-face 'face-alias 'custom-button-pressed)
 
+(defface custom-button-pressed-unraised
+  '((default :inherit custom-button-unraised)
+    (((class color) (background light)) :foreground "magenta4")
+    (((class color) (background dark)) :foreground "violet"))
+  "Face for pressed custom buttons if `custom-raised-buttons' is nil."
+  :version "22.1"
+  :group 'custom-faces)
+
+(setq custom-button-pressed
+  (if custom-raised-buttons
+      'custom-button-pressed
+    'custom-button-pressed-unraised))
+
 (defface custom-documentation nil
   "Face used for documentation strings in customization buffers."
   :group 'custom-faces)
@@ -4311,10 +4353,11 @@
   (make-local-variable 'widget-documentation-face)
   (setq widget-documentation-face 'custom-documentation)
   (make-local-variable 'widget-button-face)
-  (setq widget-button-face 'custom-button)
-  (set (make-local-variable 'widget-button-pressed-face) 'custom-button-pressed)
-  (set (make-local-variable 'widget-mouse-face)
-       'custom-button-pressed)		; buttons `depress' when moused
+  (setq widget-button-face custom-button)
+  (set (make-local-variable 'widget-button-pressed-face) custom-button-pressed)
+  (if custom-raised-buttons
+      (set (make-local-variable 'widget-mouse-face) custom-button))
+
   ;; When possible, use relief for buttons, not bracketing.  This test
   ;; may not be optimal.
   (when custom-raised-buttons
--- a/lisp/wid-edit.el	Sun Oct 23 17:26:53 2005 +0000
+++ b/lisp/wid-edit.el	Sun Oct 23 17:40:38 2005 +0000
@@ -403,10 +403,7 @@
     ;; We want to avoid the face with image buttons.
     (unless (widget-get widget :suppress-face)
       (overlay-put overlay 'face (widget-apply widget :button-face-get))
-      ; Text terminals cannot change mouse pointer shape, so use mouse
-      ; face instead.
-      (or (display-graphic-p)
-	  (overlay-put overlay 'mouse-face widget-mouse-face)))
+      (overlay-put overlay 'mouse-face widget-mouse-face))
     (overlay-put overlay 'pointer 'hand)
     (overlay-put overlay 'follow-link follow-link)
     (overlay-put overlay 'help-echo help-echo)))
@@ -664,11 +661,9 @@
   "Move to where you click, and if it is an active field, invoke it."
   (interactive "e")
   (mouse-set-point event)
-  (if (widget-event-point event)
-      (let* ((pos (widget-event-point event))
-	     (button (get-char-property pos 'button)))
-	(if button
-	    (widget-button-click event)))))
+  (let ((pos (widget-event-point event)))
+    (if (and pos (get-char-property pos 'button))
+	(widget-button-click event))))
 
 ;;; Buttons.