Function: eieio-object-value-create

eieio-object-value-create is a byte-compiled function defined in eieio-custom.el.gz.

Signature

(eieio-object-value-create WIDGET)

Documentation

Create the value of WIDGET.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/eieio-custom.el.gz
(defun eieio-object-value-create (widget)
  "Create the value of WIDGET."
  (if (not (widget-get widget :value))
      (widget-put widget
		  :value (cond ((widget-get widget :objecttype)
				(funcall (eieio--class-constructor
					  (widget-get widget :objecttype))
					 "Custom-new"))
			       ((widget-get widget :objectcreatefcn)
				(funcall (widget-get widget :objectcreatefcn)))
			       (t (error "No create method specified")))))
  (let* ((chil nil)
	 (obj (widget-get widget :value))
	 (master-group (widget-get widget :eieio-group))
	 (cv (eieio--object-class obj))
	 (slots (eieio--class-slots cv)))
    ;; First line describes the object, but may not editable.
    (if (widget-get widget :eieio-show-name)
	(setq chil (cons (widget-create-child-and-convert
			  widget 'string :tag "Object "
			  :sample-face 'bold
			  (eieio-object-name-string obj))
			 chil)))
    ;; Display information about the group being shown
    (when master-group
      (let ((groups (eieio--class-option (eieio--object-class obj)
                                         :custom-groups)))
	(widget-insert "Groups:")
	(while groups
	  (widget-insert "  ")
	  (if (eq (car groups) master-group)
	      (widget-insert "*" (capitalize (symbol-name master-group)) "*")
	    (widget-create 'push-button
			   :thing (cons obj (car groups))
			   :notify (lambda (widget &rest _)
				     (eieio-customize-object
				      (car (widget-get widget :thing))
				      (cdr (widget-get widget :thing))))
			   (capitalize (symbol-name (car groups)))))
	  (setq groups (cdr groups)))
	(widget-insert "\n\n")))
    ;; Loop over all the slots, creating child widgets.
    (dotimes (i (length slots))
      (let* ((slot (aref slots i))
             (sname (eieio-slot-descriptor-name slot))
             (props (cl--slot-descriptor-props slot)))
        ;; Output this slot if it has a customize flag associated with it.
        (when (and (alist-get :custom props)
                   (or (not master-group)
                       (member master-group (alist-get :group props)))
                   (slot-boundp obj (cl--slot-descriptor-name slot)))
          ;; In this case, this slot has a custom type.  Create its
          ;; children widgets.
          (let ((type (eieio-filter-slot-type widget (alist-get :custom props)))
                (stuff nil))
            ;; This next bit is an evil hack to get some EDE functions
            ;; working the way I like.
            (if (and (listp type)
                     (setq stuff (member :slotofchoices type)))
                (let ((choices (eieio-oref obj (car (cdr stuff))))
                      (newtype nil))
                  (while (not (eq (car type) :slotofchoices))
                    (setq newtype (cons (car type) newtype)
                          type (cdr type)))
                  (while choices
                    (setq newtype (cons (list 'const (car choices))
                                        newtype)
                          choices (cdr choices)))
                  (setq type (nreverse newtype))))
            (setq chil (cons (widget-create-child-and-convert
                              widget 'object-slot
                              :childtype type
                              :sample-face 'eieio-custom-slot-tag-face
                              :tag
                              (concat
                               (make-string
                                (or (widget-get widget :indent) 0)
                                ?\s)
                               (or (alist-get :label props)
                                   (let ((s (symbol-name
                                             (or
                                              (eieio--class-slot-initarg
                                               (eieio--object-class obj)
					       sname)
					      sname))))
                                     (capitalize
                                      (if (string-match "^:" s)
                                          (substring s (match-end 0))
                                        s)))))
                              :value (slot-value obj sname)
                              :doc  (or (alist-get :documentation props)
                                        "Slot not Documented.")
                              :eieio-custom-visibility 'visible
                              )
                             chil))
            ))))
    (widget-put widget :children (nreverse chil))
    ))