comparison lisp/cus-edit.el @ 66336:d9a2701e02cd

* 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.

66335:781c3e37424c

(defun Custom-buffer-done (&rest ignore)
  "Exit current Custom buffer according to `custom-buffer-done-kill'."
  (interactive)
  (quit-window custom-buffer-done-kill))

(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)

(defun custom-buffer-create-internal (options &optional description)
  (custom-mode)
  (if custom-buffer-verbose-help
      (progn

  '((((type x w32 mac) (class color))		; Like default modeline
     (:box (:line-width 2 :style released-button)
	   :background "lightgrey" :foreground "black"))
    (t
     nil))
  "Face used for buttons in customization buffers."
  :version "21.1"
  :group 'custom-faces)
;; backward-compatibility alias
(put 'custom-button-face 'face-alias 'custom-button)

(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."
  :version "21.1"
  :group 'custom-faces)
;; backward-compatibility alias
(put 'custom-button-pressed-face 'face-alias 'custom-button-pressed)

(defface custom-documentation nil
  "Face used for documentation strings in customization buffers."
  :group 'custom-faces)
;; backward-compatibility alias

  (make-local-variable 'custom-options)
  (make-local-variable 'custom-local-buffer)
  (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
  ;; When possible, use relief for buttons, not bracketing.  This test
  ;; may not be optimal.
  (when custom-raised-buttons
    (set (make-local-variable 'widget-push-button-prefix) "")
    (set (make-local-variable 'widget-push-button-suffix) "")

66336:d9a2701e02cd

(defun Custom-buffer-done (&rest ignore)
  "Exit current Custom buffer according to `custom-buffer-done-kill'."
  (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
  :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)
  (if custom-buffer-verbose-help
      (progn

  '((((type x w32 mac) (class color))		; Like default modeline
     (:box (:line-width 2 :style released-button)
	   :background "lightgrey" :foreground "black"))
    (t
     nil))
  "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 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)
;; backward-compatibility alias

  (make-local-variable 'custom-options)
  (make-local-variable 'custom-local-buffer)
  (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)
  (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
    (set (make-local-variable 'widget-push-button-prefix) "")
    (set (make-local-variable 'widget-push-button-suffix) "")