Function: custom-face-value-create

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

Signature

(custom-face-value-create WIDGET)

Documentation

Create a list of the display specifications for WIDGET.

Source Code

;; Defined in /usr/src/emacs/lisp/cus-edit.el.gz
(defun custom-face-value-create (widget)
  "Create a list of the display specifications for WIDGET."
  (let* ((buttons (widget-get widget :buttons))
	 (symbol  (widget-get widget :value))
	 (tag (or (widget-get widget :tag)
		  (prin1-to-string symbol)))
	 (hiddenp (eq (widget-get widget :custom-state) 'hidden))
	 (style   (widget-get widget :custom-style))
	 children)

    (if (eq custom-buffer-style 'tree)

	;; Draw a tree-style `custom-face' widget
	(progn
	  (insert (widget-get widget :custom-prefix)
		  (if (widget-get widget :custom-last) " `--- " " |--- "))
	  (push (widget-create-child-and-convert
		 widget 'custom-browse-face-tag)
		buttons)
	  (insert " " tag "\n")
	  (widget-put widget :buttons buttons))

      ;; Draw an ordinary `custom-face' widget
      ;; Visibility indicator.
      (push (widget-create-child-and-convert
             widget 'custom-visibility
             :help-echo "Hide or show this face."
             :on "Hide" :off "Show"
             :on-glyph "down" :off-glyph "right"
             :action 'custom-toggle-hide-face
             (not hiddenp))
            buttons)
      ;; Face name (tag).
      (insert " ")
      (push (widget-create-child-and-convert
             widget 'face-link
	     :button-face 'link
             :tag tag
             :action (lambda (&rest _x)
                       (find-face-definition symbol)))
            buttons)
      (insert
       (cond ((eq custom-buffer-style 'face) " ")
	     ((string-match-p "face\\'" tag)   ":")
	     (t " face: ")))

      ;; Face sample.
      (let ((sample-indent (widget-get widget :sample-indent))
	    (indent-tabs-mode nil))
	(and sample-indent
	     (<= (current-column) sample-indent)
	     (indent-to-column sample-indent)))
      (push (widget-create-child-and-convert
	     widget 'item
	     :format "[%{%t%}]"
	     :sample-face (let ((spec (widget-get widget :shown-value)))
			    (if spec (face-spec-choose spec) symbol))
	     :tag "sample")
	    buttons)
      (insert "\n")

      ;; Magic.
      (unless (eq (widget-get widget :custom-style) 'simple)
	(let ((magic (widget-create-child-and-convert
		      widget 'custom-magic nil)))
	  (widget-put widget :custom-magic magic)
	  (push magic buttons)))

      ;; Update buttons.
      (widget-put widget :buttons buttons)

      ;; Insert documentation.
      (unless (and hiddenp (eq style 'simple))
	(widget-put widget :documentation-indent 3)
	(widget-add-documentation-string-button
	 widget :visibility-widget 'custom-visibility)
	;; The comment field
	(unless hiddenp
	  (let* ((comment (get symbol 'face-comment))
		 (comment-widget
		  (widget-create-child-and-convert
		   widget 'custom-comment
		   :parent widget
		   :value (or comment ""))))
	    (widget-put widget :comment-widget comment-widget)
	    (push comment-widget children))))

      ;; Editor.
      (unless (eq (preceding-char) ?\n)
	(insert "\n"))
      (unless hiddenp
	(custom-load-widget widget)
	(unless (widget-get widget :custom-form)
	  (widget-put widget :custom-form custom-face-default-form))

	(let* ((spec (or (widget-get widget :shown-value)
			 (custom-face-get-current-spec symbol)))
	       (form (widget-get widget :custom-form))
	       (indent (widget-get widget :indent))
	       face-alist face-entry spec-default spec-match editor)

	  ;; Find a display in SPEC matching the selected display.
	  ;; This will use the usual face customization interface.
	  (setq face-alist spec)
	  (when (eq (car-safe (car-safe face-alist)) 'default)
	    (setq spec-default (pop face-alist)))

	  (while (and face-alist (listp face-alist) (null spec-match))
	    (setq face-entry (car face-alist))
	    (and (listp face-entry)
		 (face-spec-set-match-display (car face-entry)
					      (selected-frame))
		 (widget-apply custom-face-edit :match (cadr face-entry))
		 (setq spec-match face-entry))
	    (setq face-alist (cdr face-alist)))

	  ;; Insert the appropriate editing widget.
	  (setq editor
		(cond
		 ((and (eq form 'selected)
		       (or spec-match spec-default))
		  (when indent (insert-char ?\s indent))
		  (widget-create-child-and-convert
		   widget 'custom-face-edit
		   :value (cadr spec-match)
		   :default-face-attributes (cadr spec-default)))
		 ((and (not (eq form 'lisp))
		       (widget-apply custom-face-all :match spec))
		  (widget-create-child-and-convert
		   widget 'custom-face-all :value spec))
		 (t
		  (when indent
		    (insert-char ?\s indent))
		  (widget-create-child-and-convert
		   widget 'sexp :value spec))))
          (push editor children)
          (widget-put widget :children children)
	  (custom-face-state-set widget))))))