comparison lisp/wid-edit.el @ 53319:36b31fc002f2

2003-12-12 Jesper Harder <[e-mail]> * cus-edit.el (custom-add-parent-links): Define "many". 2003-12-08 Per Abrahamsen <[e-mail]> * wid-edit.el (widget-child-value-get, widget-child-value-inline) (widget-child-validate, widget-type-value-create) (widget-type-default-get, widget-type-match): New functions. (lazy): New widget. (menu-choice, checklist, radio-button-choice, editable-list) (group, documentation-string): Removed redundant (per 2003-10-25 change) calls to `widget-children-value-delete'. (widget-choice-value-get, widget-choice-value-inline): Removed functions. (menu-choice): Updated widget.

53318:d7e333de59f9

      (setq child (car children)
	    children (cdr children)
	    found (widget-apply child :validate)))
    found))

(defun widget-types-copy (widget)
  "Copy :args as widget types in WIDGET."
  (widget-put widget :args (mapcar 'widget-copy (widget-get widget :args)))
  widget)

  :format "%[%t%]: %v"
  :case-fold t
  :tag "choice"
  :void '(item :format "invalid (%t)\n")
  :value-create 'widget-choice-value-create
  :value-delete 'widget-children-value-delete
  :value-get 'widget-choice-value-get
  :value-inline 'widget-choice-value-inline
  :default-get 'widget-choice-default-get
  :mouse-down-action 'widget-choice-mouse-down-action
  :action 'widget-choice-action
  :error "Make a choice"
  :validate 'widget-choice-validate

      (when current
	(let ((void (widget-get widget :void)))
	  (widget-put widget :children (list (widget-create-child-and-convert
					      widget void :value value)))
	  (widget-put widget :choice void))))))

(defun widget-choice-value-get (widget)
  ;; Get value of the child widget.
  (widget-value (car (widget-get widget :children))))

(defun widget-choice-value-inline (widget)
  ;; Get value of the child widget.
  (widget-apply (car (widget-get widget :children)) :value-inline))

(defun widget-choice-default-get (widget)
  ;; Get default for the first choice.
  (widget-default-get (car (widget-get widget :args))))

  :format "%v"
  :offset 4
  :entry-format "%b %v"
  :greedy nil
  :value-create 'widget-checklist-value-create
  :value-delete 'widget-children-value-delete
  :value-get 'widget-checklist-value-get
  :validate 'widget-checklist-validate
  :match 'widget-checklist-match
  :match-inline 'widget-checklist-match-inline)

  :copy 'widget-types-copy
  :offset 4
  :format "%v"
  :entry-format "%b %v"
  :value-create 'widget-radio-value-create
  :value-delete 'widget-children-value-delete
  :value-get 'widget-radio-value-get
  :value-inline 'widget-radio-value-inline
  :value-set 'widget-radio-value-set
  :error "You must push one of the buttons"
  :validate 'widget-radio-validate

  :offset 12
  :format "%v%i\n"
  :format-handler 'widget-editable-list-format-handler
  :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
  :validate 'widget-children-validate
  :match 'widget-editable-list-match
  :match-inline 'widget-editable-list-match-inline
  :insert-before 'widget-editable-list-insert-before

  "A widget which groups other widgets inside."
  :convert-widget 'widget-types-convert-widget
  :copy 'widget-types-copy
  :format "%v"
  :value-create 'widget-group-value-create
  :value-delete 'widget-children-value-delete
  :value-get 'widget-editable-list-value-get
  :default-get 'widget-group-default-get
  :validate 'widget-children-validate
  :match 'widget-group-match
  :match-inline 'widget-group-match-inline)

(define-widget 'documentation-string 'item
  "A documentation string."
  :format "%v"
  :action 'widget-documentation-string-action
  :value-delete 'widget-children-value-delete
  :value-create 'widget-documentation-string-value-create)

(defun widget-documentation-string-value-create (widget)
  ;; Insert documentation string.
  (let ((doc (widget-value widget))

(defun widget-cons-match (widget value)
  (and (consp value)
       (widget-group-match widget
			   (widget-apply widget :value-to-internal value))))

;;; The `plist' Widget.
;;
;; Property lists.

53319:36b31fc002f2

      (setq child (car children)
	    children (cdr children)
	    found (widget-apply child :validate)))
    found))

(defun widget-child-value-get (widget)
  "Get the value of the first member of :children in WIDGET."
  (widget-value (car (widget-get widget :children))))

(defun widget-child-value-inline (widget)
  "Get the inline value of the first member of :children in WIDGET."
  (widget-apply (car (widget-get widget :children)) :value-inline))

(defun widget-child-validate (widget)
  "The result of validating the first member of :children in WIDGET."
  (widget-apply (car (widget-get widget :children)) :validate))

(defun widget-type-value-create (widget)
  "Convert and instantiate the value of the :type attribute of WIDGET.
Store the newly created widget in the :children attribute.

The value of the :type attribute should be an unconverted widget type."
  (let ((value (widget-get widget :value))
	(type (widget-get widget :type)))
    (widget-put widget :children 
                (list (widget-create-child-value widget 
                                                 (widget-convert type)
                                                 value)))))

(defun widget-type-default-get (widget)
  "Get default value from the :type attribute of WIDGET.

The value of the :type attribute should be an unconverted widget type."
  (widget-default-get (widget-convert (widget-get widget :type))))

(defun widget-type-match (widget value)
  "Non-nil if the :type value of WIDGET matches VALUE.

The value of the :type attribute should be an unconverted widget type."
  (widget-apply (widget-convert (widget-get widget :type)) :match value))

(defun widget-types-copy (widget)
  "Copy :args as widget types in WIDGET."
  (widget-put widget :args (mapcar 'widget-copy (widget-get widget :args)))
  widget)

  :format "%[%t%]: %v"
  :case-fold t
  :tag "choice"
  :void '(item :format "invalid (%t)\n")
  :value-create 'widget-choice-value-create
  :value-get 'widget-child-value-get
  :value-inline 'widget-child-value-inline
  :default-get 'widget-choice-default-get
  :mouse-down-action 'widget-choice-mouse-down-action
  :action 'widget-choice-action
  :error "Make a choice"
  :validate 'widget-choice-validate

      (when current
	(let ((void (widget-get widget :void)))
	  (widget-put widget :children (list (widget-create-child-and-convert
					      widget void :value value)))
	  (widget-put widget :choice void))))))

(defun widget-choice-default-get (widget)
  ;; Get default for the first choice.
  (widget-default-get (car (widget-get widget :args))))

  :format "%v"
  :offset 4
  :entry-format "%b %v"
  :greedy nil
  :value-create 'widget-checklist-value-create
  :value-get 'widget-checklist-value-get
  :validate 'widget-checklist-validate
  :match 'widget-checklist-match
  :match-inline 'widget-checklist-match-inline)

  :copy 'widget-types-copy
  :offset 4
  :format "%v"
  :entry-format "%b %v"
  :value-create 'widget-radio-value-create
  :value-get 'widget-radio-value-get
  :value-inline 'widget-radio-value-inline
  :value-set 'widget-radio-value-set
  :error "You must push one of the buttons"
  :validate 'widget-radio-validate

  :offset 12
  :format "%v%i\n"
  :format-handler 'widget-editable-list-format-handler
  :entry-format "%i %d %v"
  :value-create 'widget-editable-list-value-create
  :value-get 'widget-editable-list-value-get
  :validate 'widget-children-validate
  :match 'widget-editable-list-match
  :match-inline 'widget-editable-list-match-inline
  :insert-before 'widget-editable-list-insert-before

  "A widget which groups other widgets inside."
  :convert-widget 'widget-types-convert-widget
  :copy 'widget-types-copy
  :format "%v"
  :value-create 'widget-group-value-create
  :value-get 'widget-editable-list-value-get
  :default-get 'widget-group-default-get
  :validate 'widget-children-validate
  :match 'widget-group-match
  :match-inline 'widget-group-match-inline)

(define-widget 'documentation-string 'item
  "A documentation string."
  :format "%v"
  :action 'widget-documentation-string-action
  :value-create 'widget-documentation-string-value-create)

(defun widget-documentation-string-value-create (widget)
  ;; Insert documentation string.
  (let ((doc (widget-value widget))

(defun widget-cons-match (widget value)
  (and (consp value)
       (widget-group-match widget
			   (widget-apply widget :value-to-internal value))))

;;; The `lazy' Widget.
;;
;; Recursive datatypes.

(define-widget 'lazy 'default
  "Base widget for recursive datastructures.

The `lazy' widget will, when instantiated, contain a single inferior
widget, of the widget type specified by the :type parameter.  The
value of the `lazy' widget is the same as the value of the inferior
widget.  When deriving a new widget from the 'lazy' widget, the :type
parameter is allowed to refer to the widget currently being defined,
thus allowing recursive datastructures to be described.

The :type parameter takes the same arguments as the defcustom
parameter with the same name.

Most composite widgets, i.e. widgets containing other widgets, does
not allow recursion.  That is, when you define a new widget type, none
of the inferior widgets may be of the same type you are currently
defining.

In Lisp, however, it is custom to define datastructures in terms of
themselves.  A list, for example, is defined as either nil, or a cons
cell whose cdr itself is a list.  The obvious way to translate this
into a widget type would be

  (define-widget 'my-list 'choice
    \"A list of sexps.\"
    :tag \"Sexp list\"
    :args '((const nil) (cons :value (nil) sexp my-list)))

Here we attempt to define my-list as a choice of either the constant
nil, or a cons-cell containing a sexp and my-lisp.  This will not work
because the `choice' widget does not allow recursion.

Using the `lazy' widget you can overcome this problem, as in this 
example: 

  (define-widget 'sexp-list 'lazy
    \"A list of sexps.\"
    :tag \"Sexp list\"
    :type '(choice (const nil) (cons :value (nil) sexp sexp-list)))"
  :format "%{%t%}: %v"
  ;; We don't convert :type because we want to allow recursive
  ;; datastructures.  This is slow, so we should not create speed
  ;; critical widgets by deriving from this. 
  :convert-widget 'widget-value-convert-widget
  :value-create 'widget-type-value-create
  :value-get 'widget-child-value-get
  :value-inline 'widget-child-value-inline
  :default-get 'widget-type-default-get
  :match 'widget-type-match
  :validate 'widget-child-validate)


;;; The `plist' Widget.
;;
;; Property lists.