Function: custom-variable-value-create

custom-variable-value-create is a byte-compiled function defined in cus-edit.el.gz.

Signature

(custom-variable-value-create WIDGET)

Documentation

Here is where you edit the variable's value.

Source Code

;; Defined in /usr/src/emacs/lisp/cus-edit.el.gz
(defun custom-variable-value-create (widget)
  "Here is where you edit the variable's value."
  (custom-load-widget widget)
  (unless (widget-get widget :custom-form)
    (widget-put widget :custom-form custom-variable-default-form))
  (let* ((buttons (widget-get widget :buttons))
	 (children (widget-get widget :children))
	 (form (widget-get widget :custom-form))
	 (symbol (widget-get widget :value))
	 (tag (widget-get widget :tag))
	 (type (custom-variable-type symbol))
	 (conv (widget-convert type))
	 (get (or (get symbol 'custom-get) 'default-value))
	 (prefix (widget-get widget :custom-prefix))
	 (last (widget-get widget :custom-last))
	 (style (widget-get widget :custom-style))
	 (value (let ((shown-value (widget-get widget :shown-value)))
		  (cond (shown-value
			 (car shown-value))
			((default-boundp symbol)
			 (funcall get symbol))
			(t (widget-get conv :value)))))
	 (state (or (widget-get widget :custom-state)
		    (if (memq (custom-variable-state symbol value)
			      (widget-get widget :hidden-states))
			'hidden)))
	 (obsolete (get symbol 'byte-obsolete-variable)))

    ;; If we don't know the state, see if we need to edit it in lisp form.
    (unless state
      (with-suppressed-warnings ((obsolete custom-show))
        (setq state (if (custom-show type value) 'unknown 'hidden))))
    (when (eq state 'unknown)
      (unless (widget-apply conv :match value)
	(setq form 'mismatch)))
    ;; Now we can create the child widget.
    (cond ((eq custom-buffer-style 'tree)
	   (insert prefix (if last " `--- " " |--- "))
	   (push (widget-create-child-and-convert
		  widget 'custom-browse-variable-tag)
		 buttons)
	   (insert " " tag "\n")
	   (widget-put widget :buttons buttons))
	  ((eq state 'hidden)
	   ;; Indicate hidden value.
	   (push (widget-create-child-and-convert
		  widget 'custom-visibility
		  :help-echo "Show the value of this option."
		  :on-glyph "down"
		  :on "Hide"
		  :off-glyph "right"
		  :off "Show Value"
		  :action 'custom-toggle-hide-variable
		  nil)
		 buttons)
	   (insert " ")
	   (push (widget-create-child-and-convert
		  widget 'item
		  :format "%{%t%} "
		  :sample-face (if obsolete
				   'custom-variable-obsolete
				 'custom-variable-tag)
		  :tag tag
		  :parent widget)
		 buttons))
	  ((memq form '(lisp mismatch))
	   (push (widget-create-child-and-convert
		  widget 'custom-visibility
		  :help-echo "Hide the value of this option."
		  :on "Hide"
		  :off "Show"
		  :on-glyph "down"
		  :off-glyph "right"
		  :action 'custom-toggle-hide-variable
		  t)
		 buttons)
	   (insert " ")
	   ;; This used to try presenting the saved value or the
	   ;; standard value, but it seems more intuitive to present
	   ;; the current value (Bug#7600).
	   (let* ((value (cond ((default-boundp symbol)
				(custom-quote (funcall get symbol)))
			       (t
				(custom-quote (widget-get conv :value))))))
	     (insert (symbol-name symbol) ": ")
	     (push (widget-create-child-and-convert
		    widget 'sexp
		    :button-face 'custom-variable-button-face
		    :format "%v"
		    :tag (symbol-name symbol)
		    :parent widget
		    :value value)
		   children)))
	  (t
	   ;; Edit mode.
	   (push (widget-create-child-and-convert
		  widget 'custom-visibility
		  :help-echo "Hide or show this option."
		  :on "Hide"
		  :off "Show"
		  :on-glyph "down"
		  :off-glyph "right"
		  :action 'custom-toggle-hide-variable
		  t)
		 buttons)
	   (insert " ")
	   (let* ((format (widget-get type :format))
                  tag-format)
             ;; We used to drop the widget tag when creating TYPE, passing
             ;; everything after the colon (including whitespace characters
             ;; after it) as the :format for TYPE.  We don't drop the tag
             ;; anymore, but we should keep an immediate whitespace character,
             ;; if present, and it's easier to do it here.
             (unless (string-match ":\\s-?" format)
	       (error "Bad format"))
	     (setq tag-format (substring format 0 (match-end 0)))
	     (push (widget-create-child-and-convert
		    widget 'item
		    :format tag-format
		    :action 'custom-tag-action
		    :help-echo "Change value of this option."
		    :mouse-down-action 'custom-tag-mouse-down-action
		    :button-face 'custom-variable-button
		    :sample-face (if obsolete
				     'custom-variable-obsolete
				   'custom-variable-tag)
		    :tag tag)
		   buttons)
	     (push (widget-create-child-and-convert
		    widget type
		    :value value)
		   children))))
    (unless (eq custom-buffer-style 'tree)
      (unless (eq (preceding-char) ?\n)
	(widget-insert "\n"))
      ;; Create the magic button.
      (unless (eq style 'simple)
	(let ((magic (widget-create-child-and-convert
		      widget 'custom-magic nil)))
	  (widget-put widget :custom-magic magic)
	  (push magic buttons)))
      (widget-put widget :buttons buttons)
      ;; Insert documentation.
      (widget-put widget :documentation-indent 3)
      (unless (and (eq style 'simple)
		   (eq state 'hidden))
	(widget-add-documentation-string-button
	 widget :visibility-widget 'custom-visibility))

      ;; The comment field
      (unless (eq state 'hidden)
	(let* ((comment (get symbol 'variable-comment))
	       (comment-widget
		(widget-create-child-and-convert
		 widget 'custom-comment
		 :parent widget
		 :value (or comment ""))))
	  (widget-put widget :comment-widget comment-widget)
	  ;; Don't push it !!! Custom assumes that the first child is the
	  ;; value one.
	  (setq children (append children (list comment-widget)))))
      ;; Update the rest of the properties.
      (widget-put widget :custom-form form)
      (widget-put widget :children children)
      ;; Now update the state.
      (if (eq state 'hidden)
	  (widget-put widget :custom-state state)
	(custom-variable-state-set widget))
      ;; See also.
      (unless (eq state 'hidden)
	(when (eq (widget-get widget :custom-level) 1)
	  (custom-add-parent-links widget))
	(custom-add-see-also widget)))))