;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t;-*-
;;
-;; Copyright (C) 1996, 1997, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1999, 2000, 2001 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
:type 'face
:group 'widget-faces)
-(defface widget-field-face '((((class grayscale color)
+;; TTY gets special definitions here and in the next defface, because
+;; the gray colors defined for other displays cause black text on a black
+;; background, at least on light-background TTYs.
+(defface widget-field-face '((((type tty))
+ (:background "yellow3"))
+ (((class grayscale color)
(background light))
(:background "gray85"))
(((class grayscale color)
"Face used for editable fields."
:group 'widget-faces)
-(defface widget-single-line-field-face '((((class grayscale color)
+(defface widget-single-line-field-face '((((type tty))
+ (:background "green3"))
+ (((class grayscale color)
(background light))
(:background "gray85"))
(((class grayscale color)
Optional ARGS are extra keyword arguments for TYPE."
(let ((widget (apply 'widget-convert type :delete 'widget-leave-text args))
(from (copy-marker from))
- (to (copy-marker to))
- (personality (get-text-property from 'personality)))
+ (to (copy-marker to)))
(set-marker-insertion-type from t)
(set-marker-insertion-type to nil)
(widget-put widget :from from)
(widget-put widget :to to)
(when button-from
(widget-specify-button widget button-from button-to))
- ;; W3 provides advice for this for Emacspeak's benefit.
- (if personality
- (put-text-property from to 'personality personality))
widget))
(defun widget-convert-button (type from to &rest args)
;; Mouse click on a widget button. Do the following
;; in a save-excursion so that the click on the button
;; doesn't change point.
- (progn
+ (save-selected-window
(save-excursion
(mouse-set-point event)
(let* ((overlay (widget-get button :button-overlay))
;;; The `text' Widget.
(define-widget 'text 'editable-field
- :keymap widget-text-keymap
- "A multiline text area.")
+ "A multiline text area."
+ :keymap widget-text-keymap)
;;; The `menu-choice' Widget.
(defun widget-toggle-value-create (widget)
"Insert text representing the `on' and `off' states."
(if (widget-value widget)
- (widget-image-insert widget
- (widget-get widget :on)
- (widget-get widget :on-glyph))
+ (progn
+ (and (display-graphic-p)
+ (listp (widget-get widget :on-glyph))
+ (widget-put widget :on-glyph
+ (eval (widget-get widget :on-glyph))))
+ (widget-image-insert widget
+ (widget-get widget :on)
+ (widget-get widget :on-glyph)))
+ (and (display-graphic-p)
+ (listp (widget-get widget :off-glyph))
+ (widget-put widget :off-glyph
+ (eval (widget-get widget :off-glyph))))
(widget-image-insert widget
(widget-get widget :off)
(widget-get widget :off-glyph))))
;; We could probably do the same job as the images using single
;; space characters in a boxed face with a stretch specification to
;; make them square.
- :on-glyph (create-image "\377\311\301\343\301\311\377" ; this is an `X'
- 'xbm t :width 7 :height 7
- :foreground "grey75" ; like default mode line
- :background "black"
- :relief -3
- :ascent 'center)
- :off "[ ]"
- :off-glyph (create-image (make-bool-vector 49 1)
+ :on-glyph '(create-image "\000\066\076\034\076\066\000"
'xbm t :width 7 :height 7
- :foreground "grey75"
- :relief 3
+ :background "grey75" ; like default mode line
+ :foreground "black"
+ :relief -3
:ascent 'center)
+ :off "[ ]"
+ :off-glyph '(create-image (make-string 7 0)
+ 'xbm t :width 7 :height 7
+ :background "grey75"
+ :foreground "black"
+ :relief 3
+ :ascent 'center)
:help-echo "Toggle this item."
:action 'widget-checkbox-action)
:format "%v"
:offset 4
:entry-format "%b %v"
- :menu-tag "checklist"
:greedy nil
:value-create 'widget-checklist-value-create
:value-delete 'widget-children-value-delete
:offset 4
:format "%v"
:entry-format "%b %v"
- :menu-tag "radio"
:value-create 'widget-radio-value-create
:value-delete 'widget-children-value-delete
:value-get 'widget-radio-value-get
;; Pass notification to parent.
(widget-apply widget :notify child event))
-;;; The `insert/delete-button' Widget.
-
-(define-widget 'insert/delete-button 'push-button
- "An insert/delete item button for the `editable-list' widget."
- :create (lambda (widget)
- (let* ((map (make-sparse-keymap))
- (parent (widget-get widget :keymap)))
- (if parent
- (set-keymap-parent map parent))
- (define-key map [?\C-k] #'widget-list-item-delete)
- (define-key map [?\C-o] #'widget-list-item-insert)
- (widget-put widget :keymap map))
- (widget-default-create widget))
- :tag "+/-"
- :help-echo "Insert or delete a new item into the list here"
- :action 'widget-insert/delete-button-action)
-
-(defun widget-insert/delete-button-action (widget &optional event)
- "Ask the parent to insert or delete a new item."
- (if (y-or-n-p "Delete this item? (otherwise insert a new one)")
- (widget-apply (widget-get widget :parent)
- :delete-at (widget-get widget :widget))
- (widget-apply (widget-get widget :parent)
- :insert-before (widget-get widget :widget))))
-
-(defun widget-list-item-insert ()
- "Delete the list item widget which is the parent of the widget at point."
- (interactive)
- (let ((widget (widget-at (point))))
- (widget-apply (widget-get widget :parent)
- :insert-before (widget-get widget :widget))))
-
-(defun widget-list-item-delete ()
- "Add a new list item widget after the parent of the widget at point."
- (interactive)
- (let ((widget (widget-at (point))))
- (widget-apply (widget-get widget :parent)
- :delete-at (widget-get widget :widget))))
-
;;; The `insert-button' Widget.
(define-widget 'insert-button 'push-button
- "An append item button for the `editable-list' widget."
- :tag "+"
- :help-echo "Append a new item to the list"
+ "An insert button for the `editable-list' widget."
+ :tag "INS"
+ :help-echo "Insert a new item into the list at this position."
:action 'widget-insert-button-action)
(defun widget-insert-button-action (widget &optional event)
(widget-apply (widget-get widget :parent)
:insert-before (widget-get widget :widget)))
+;;; The `delete-button' Widget.
+
+(define-widget 'delete-button 'push-button
+ "A delete button for the `editable-list' widget."
+ :tag "DEL"
+ :help-echo "Delete this item from the list."
+ :action 'widget-delete-button-action)
+
+(defun widget-delete-button-action (widget &optional event)
+ ;; Ask the parent to insert a new item.
+ (widget-apply (widget-get widget :parent)
+ :delete-at (widget-get widget :widget)))
+
;;; The `editable-list' Widget.
;; (defcustom widget-editable-list-gui nil
:offset 12
:format "%v%i\n"
:format-handler 'widget-editable-list-format-handler
- :entry-format "%- %v"
- :menu-tag "editable-list"
+ :entry-format "%i %d %v"
:value-create 'widget-editable-list-value-create
:value-delete 'widget-children-value-delete
:value-get 'widget-editable-list-value-get
;; Create a new entry to the list.
(let ((type (nth 0 (widget-get widget :args)))
;;; (widget-push-button-gui widget-editable-list-gui)
- child ins/del buttons)
+ child delete insert)
(widget-specify-insert
(save-excursion
(and (widget-get widget :indent)
(delete-backward-char 2)
(cond ((eq escape ?%)
(insert ?%))
- ((eq escape ?-)
- (setq ins/del (apply 'widget-create-child-and-convert
- widget 'insert/delete-button
- (widget-get widget
- :insert/delete-button-args))))
+ ((eq escape ?i)
+ (setq insert (apply 'widget-create-child-and-convert
+ widget 'insert-button
+ (widget-get widget :insert-button-args))))
+ ((eq escape ?d)
+ (setq delete (apply 'widget-create-child-and-convert
+ widget 'delete-button
+ (widget-get widget :delete-button-args))))
((eq escape ?v)
(if conv
(setq child (widget-create-child-value
(widget-default-get type))))))
(t
(error "Unknown escape `%c'" escape)))))
- (setq buttons (widget-get widget :buttons))
- (if ins/del
- (push ins/del buttons))
- (widget-put widget :buttons buttons)
+ (widget-put widget
+ :buttons (cons delete
+ (cons insert
+ (widget-get widget :buttons))))
(let ((entry-from (point-min-marker))
(entry-to (point-max-marker)))
(set-marker-insertion-type entry-from t)
(set-marker-insertion-type entry-to nil)
(widget-put child :entry-from entry-from)
(widget-put child :entry-to entry-to)))
- (if ins/del (widget-put ins/del :widget child))
+ (widget-put insert :widget child)
+ (widget-put delete :widget child)
child))
;;; The `group' Widget.
"History of input to `widget-variable-prompt-value'.")
(define-widget 'variable 'symbol
- ;; Should complete on variables.
"A Lisp variable."
:prompt-match 'boundp
:prompt-history 'widget-variable-prompt-value-history
(defun widget-color-sample-face-get (widget)
(let* ((value (condition-case nil
(widget-value widget)
- (error (widget-get widget :value))))
- (symbol (intern (concat "fg:" value))))
- (condition-case nil
- (facemenu-get-face symbol)
- (error 'default))))
+ (error (widget-get widget :value)))))
+ (if (color-defined-p value)
+ (list (cons 'foreground-color value))
+ 'default)))
(defun widget-color-action (widget &optional event)
"Prompt for a color."