/[emacs]/emacs/lisp/wid-edit.el
ViewVC logotype

Diff of /emacs/lisp/wid-edit.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.138 by dann, Fri Apr 8 14:26:13 2005 UTC revision 1.139 by miles, Fri Jun 10 07:16:40 2005 UTC
# Line 89  Line 89 
89    :group 'widgets    :group 'widgets
90    :group 'faces)    :group 'faces)
91    
92  (defvar widget-documentation-face 'widget-documentation-face  (defvar widget-documentation-face 'widget-documentation
93    "Face used for documentation strings in widgets.    "Face used for documentation strings in widgets.
94  This exists as a variable so it can be set locally in certain buffers.")  This exists as a variable so it can be set locally in certain buffers.")
95    
96  (defface widget-documentation-face '((((class color)  (defface widget-documentation '((((class color)
97                                         (background dark))                                    (background dark))
98                                        (:foreground "lime green"))                                   (:foreground "lime green"))
99                                       (((class color)                                  (((class color)
100                                         (background light))                                    (background light))
101                                        (:foreground "dark green"))                                   (:foreground "dark green"))
102                                       (t nil))                                  (t nil))
103    "Face used for documentation text."    "Face used for documentation text."
104    :group 'widget-documentation    :group 'widget-documentation
105    :group 'widget-faces)    :group 'widget-faces)
106    ;; backward compatibility alias
107    (put 'widget-documentation-face 'face-alias 'widget-documentation)
108    
109  (defvar widget-button-face 'widget-button-face  (defvar widget-button-face 'widget-button
110    "Face used for buttons in widgets.    "Face used for buttons in widgets.
111  This exists as a variable so it can be set locally in certain buffers.")  This exists as a variable so it can be set locally in certain buffers.")
112    
113  (defface widget-button-face '((t (:weight bold)))  (defface widget-button '((t (:weight bold)))
114    "Face used for widget buttons."    "Face used for widget buttons."
115    :group 'widget-faces)    :group 'widget-faces)
116    ;; backward compatibility alias
117    (put 'widget-button-face 'face-alias 'widget-button)
118    
119  (defcustom widget-mouse-face 'highlight  (defcustom widget-mouse-face 'highlight
120    "Face used for widget buttons when the mouse is above them."    "Face used for widget buttons when the mouse is above them."
# Line 120  This exists as a variable so it can be s Line 124  This exists as a variable so it can be s
124  ;; TTY gets special definitions here and in the next defface, because  ;; TTY gets special definitions here and in the next defface, because
125  ;; the gray colors defined for other displays cause black text on a black  ;; the gray colors defined for other displays cause black text on a black
126  ;; background, at least on light-background TTYs.  ;; background, at least on light-background TTYs.
127  (defface widget-field-face '((((type tty))  (defface widget-field '((((type tty))
128                                :background "yellow3"                           :background "yellow3"
129                                :foreground "black")                           :foreground "black")
130                               (((class grayscale color)                          (((class grayscale color)
131                                 (background light))                            (background light))
132                                :background "gray85")                           :background "gray85")
133                               (((class grayscale color)                          (((class grayscale color)
134                                 (background dark))                            (background dark))
135                                :background "dim gray")                           :background "dim gray")
136                               (t                          (t
137                                :slant italic))                           :slant italic))
138    "Face used for editable fields."    "Face used for editable fields."
139    :group 'widget-faces)    :group 'widget-faces)
140    ;; backward-compatibility alias
141    (put 'widget-field-face 'face-alias 'widget-field)
142    
143  (defface widget-single-line-field-face '((((type tty))  (defface widget-single-line-field '((((type tty))
144                                            :background "green3"                                       :background "green3"
145                                            :foreground "black")                                       :foreground "black")
146                                           (((class grayscale color)                                      (((class grayscale color)
147                                             (background light))                                        (background light))
148                                            :background "gray85")                                       :background "gray85")
149                                           (((class grayscale color)                                      (((class grayscale color)
150                                             (background dark))                                        (background dark))
151                                            :background "dim gray")                                       :background "dim gray")
152                                           (t                                      (t
153                                            :slant italic))                                       :slant italic))
154    "Face used for editable fields spanning only a single line."    "Face used for editable fields spanning only a single line."
155    :group 'widget-faces)    :group 'widget-faces)
156    ;; backward-compatibility alias
157    (put 'widget-single-line-field-face 'face-alias 'widget-single-line-field)
158    
159  ;;; This causes display-table to be loaded, and not usefully.  ;;; This causes display-table to be loaded, and not usefully.
160  ;;;(defvar widget-single-line-display-table  ;;;(defvar widget-single-line-display-table
# Line 325  new value.") Line 333  new value.")
333             (insert-and-inherit " ")))             (insert-and-inherit " ")))
334      (setq to (point)))      (setq to (point)))
335    (let ((keymap (widget-get widget :keymap))    (let ((keymap (widget-get widget :keymap))
336          (face (or (widget-get widget :value-face) 'widget-field-face))          (face (or (widget-get widget :value-face) 'widget-field))
337          (help-echo (widget-get widget :help-echo))          (help-echo (widget-get widget :help-echo))
338          (follow-link (widget-get widget :follow-link))          (follow-link (widget-get widget :follow-link))
339          (rear-sticky          (rear-sticky
# Line 433  new value.") Line 441  new value.")
441        (prog1 (progn ,@form)        (prog1 (progn ,@form)
442          (goto-char (point-max))))))          (goto-char (point-max))))))
443    
444  (defface widget-inactive-face '((((class grayscale color)  (defface widget-inactive '((((class grayscale color)
445                                    (background dark))                               (background dark))
446                                   (:foreground "light gray"))                              (:foreground "light gray"))
447                                  (((class grayscale color)                             (((class grayscale color)
448                                    (background light))                               (background light))
449                                   (:foreground "dim gray"))                              (:foreground "dim gray"))
450                                  (t                             (t
451                                   (:slant italic)))                              (:slant italic)))
452    "Face used for inactive widgets."    "Face used for inactive widgets."
453    :group 'widget-faces)    :group 'widget-faces)
454    ;; backward-compatibility alias
455    (put 'widget-inactive-face 'face-alias 'widget-inactive)
456    
457  (defun widget-specify-inactive (widget from to)  (defun widget-specify-inactive (widget from to)
458    "Make WIDGET inactive for user modifications."    "Make WIDGET inactive for user modifications."
459    (unless (widget-get widget :inactive)    (unless (widget-get widget :inactive)
460      (let ((overlay (make-overlay from to nil t nil)))      (let ((overlay (make-overlay from to nil t nil)))
461        (overlay-put overlay 'face 'widget-inactive-face)        (overlay-put overlay 'face 'widget-inactive)
462        ;; This is disabled, as it makes the mouse cursor change shape.        ;; This is disabled, as it makes the mouse cursor change shape.
463        ;; (overlay-put overlay 'mouse-face 'widget-inactive-face)        ;; (overlay-put overlay 'mouse-face 'widget-inactive)
464        (overlay-put overlay 'evaporate t)        (overlay-put overlay 'evaporate t)
465        (overlay-put overlay 'priority 100)        (overlay-put overlay 'priority 100)
466        (overlay-put overlay 'modification-hooks '(widget-overlay-inactive))        (overlay-put overlay 'modification-hooks '(widget-overlay-inactive))
# Line 633  extension (xpm, xbm, gif, jpg, or png) l Line 643  extension (xpm, xbm, gif, jpg, or png) l
643           ;; Oh well.           ;; Oh well.
644           nil)))           nil)))
645    
646  (defvar widget-button-pressed-face 'widget-button-pressed-face  (defvar widget-button-pressed-face 'widget-button-pressed
647    "Face used for pressed buttons in widgets.    "Face used for pressed buttons in widgets.
648  This exists as a variable so it can be set locally in certain  This exists as a variable so it can be set locally in certain
649  buffers.")  buffers.")
# Line 882  Recommended as a parent keymap for modes Line 892  Recommended as a parent keymap for modes
892        (call-interactively        (call-interactively
893         (lookup-key widget-global-map (this-command-keys))))))         (lookup-key widget-global-map (this-command-keys))))))
894    
895  (defface widget-button-pressed-face  (defface widget-button-pressed
896    '((((min-colors 88) (class color))    '((((min-colors 88) (class color))
897       (:foreground "red1"))       (:foreground "red1"))
898      (((class color))      (((class color))
# Line 891  Recommended as a parent keymap for modes Line 901  Recommended as a parent keymap for modes
901       (:weight bold :underline t)))       (:weight bold :underline t)))
902    "Face used for pressed buttons."    "Face used for pressed buttons."
903    :group 'widget-faces)    :group 'widget-faces)
904    ;; backward-compatibility alias
905    (put 'widget-button-pressed-face 'face-alias 'widget-button-pressed)
906    
907  (defun widget-button-click (event)  (defun widget-button-click (event)
908    "Invoke the button that the mouse is pointing at."    "Invoke the button that the mouse is pointing at."
# Line 2953  as the value." Line 2965  as the value."
2965    :match 'widget-regexp-match    :match 'widget-regexp-match
2966    :validate 'widget-regexp-validate    :validate 'widget-regexp-validate
2967    ;; Doesn't work well with terminating newline.    ;; Doesn't work well with terminating newline.
2968    ;; :value-face 'widget-single-line-field-face    ;; :value-face 'widget-single-line-field
2969    :tag "Regexp")    :tag "Regexp")
2970    
2971  (defun widget-regexp-match (widget value)  (defun widget-regexp-match (widget value)
# Line 2979  It will read a file name from the minibu Line 2991  It will read a file name from the minibu
2991    :prompt-value 'widget-file-prompt-value    :prompt-value 'widget-file-prompt-value
2992    :format "%{%t%}: %v"    :format "%{%t%}: %v"
2993    ;; Doesn't work well with terminating newline.    ;; Doesn't work well with terminating newline.
2994    ;; :value-face 'widget-single-line-field-face    ;; :value-face 'widget-single-line-field
2995    :tag "File")    :tag "File")
2996    
2997  (defun widget-file-complete ()  (defun widget-file-complete ()

Legend:
Removed from v.1.138  
changed lines
  Added in v.1.139

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26