Function: custom-group-value-create

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

Signature

(custom-group-value-create WIDGET)

Documentation

Insert a customize group for WIDGET in the current buffer.

Source Code

;; Defined in /usr/src/emacs/lisp/cus-edit.el.gz
(defun custom-group-value-create (widget)
  "Insert a customize group for WIDGET in the current buffer."
  (unless (eq (widget-get widget :custom-state) 'hidden)
    (custom-load-widget widget))
  (let* ((state (widget-get widget :custom-state))
	 (level (widget-get widget :custom-level))
	 ;; (indent (widget-get widget :indent))
	 (prefix (widget-get widget :custom-prefix))
	 (buttons (widget-get widget :buttons))
	 (tag (substitute-command-keys (widget-get widget :tag)))
	 (symbol (widget-value widget))
	 (members (custom-group-members symbol
					(and (eq custom-buffer-style 'tree)
					     custom-browse-only-groups)))
	 (doc (substitute-command-keys (widget-docstring widget))))
    (cond ((and (eq custom-buffer-style 'tree)
		(eq state 'hidden)
		(or members (custom-unloaded-widget-p widget)))
	   (insert prefix)
	   (push (widget-create-child-and-convert
		  widget 'custom-browse-visibility
		  :tag "+")
		 buttons)
	   (insert "-- ")
	   (push (widget-create-child-and-convert
		  widget 'custom-browse-group-tag)
		 buttons)
	   (insert " " tag "\n")
	   (widget-put widget :buttons buttons))
	  ((and (eq custom-buffer-style 'tree)
		(zerop (length members)))
	   (insert prefix "[ ]-- ")
	   (push (widget-create-child-and-convert
		  widget 'custom-browse-group-tag)
		 buttons)
	   (insert " " tag "\n")
	   (widget-put widget :buttons buttons))
	  ((eq custom-buffer-style 'tree)
	   (insert prefix)
	   (if (zerop (length members))
	       (progn
		 (insert prefix "[ ]-- ")
		 ;; (widget-glyph-insert nil "[ ]" "empty")
		 ;; (widget-glyph-insert nil "-- " "horizontal")
		 (push (widget-create-child-and-convert
			widget 'custom-browse-group-tag)
		       buttons)
		 (insert " " tag "\n")
		 (widget-put widget :buttons buttons))
	     (push (widget-create-child-and-convert
		    widget 'custom-browse-visibility
		    ;; :tag-glyph "minus"
		    :tag "-")
		   buttons)
	     (insert "-\\ ")
	     ;; (widget-glyph-insert nil "-\\ " "top")
	     (push (widget-create-child-and-convert
		    widget 'custom-browse-group-tag)
		   buttons)
	     (insert " " tag "\n")
	     (widget-put widget :buttons buttons)
	     (message "Creating group...")
	     (let* ((members (custom-sort-items
			      members
			      ;; Never sort the top-level custom group.
			      (unless (eq symbol 'emacs)
				custom-browse-sort-alphabetically)
			      custom-browse-order-groups))
		    (prefixes (widget-get widget :custom-prefixes))
		    (custom-prefix-list (custom-prefix-add symbol prefixes))
		    (extra-prefix (if (widget-get widget :custom-last)
				      "   "
				    " | "))
		    (prefix (concat prefix extra-prefix))
		    children entry)
	       (while members
		 (setq entry (car members)
		       members (cdr members))
		 (push (widget-create-child-and-convert
			widget (nth 1 entry)
			:group widget
			:tag (custom-unlispify-tag-name (nth 0 entry))
			:custom-prefixes custom-prefix-list
			:custom-level (1+ level)
			:custom-last (null members)
			:value (nth 0 entry)
			:custom-prefix prefix)
		       children))
	       (widget-put widget :children (reverse children)))
	     (message "Creating group...done")))
	  ;; Nested style.
	  ((eq state 'hidden)
	   ;; Create level indicator.
	   ;; Create tag.
	   (if (eq custom-buffer-style 'links)
	       (push (widget-create-child-and-convert
		      widget 'custom-group-link
		      :tag tag
		      symbol)
		     buttons)
	     (insert-char ?\s (* custom-buffer-indent (1- level)))
	     (insert "-- ")
	     (push (widget-create-child-and-convert
		    widget 'custom-group-visibility
		    :help-echo "Show members of this group."
		    :action 'custom-toggle-parent
		    (not (eq state 'hidden)))
		   buttons))
	   (if (>= (current-column) custom-group-doc-align-col)
	       (insert "  "))
	   ;; Create magic button.
	   (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.
	   (when (eq custom-buffer-style 'links)
	       (widget-put widget :documentation-indent
			   custom-group-doc-align-col))
	   (widget-add-documentation-string-button
	    widget :visibility-widget 'custom-visibility))

	  ;; Nested style.
	  (t				;Visible.
           (custom-group--draw-horizontal-line)

	   ;; Add parent groups references above the group.
	   (when (eq level 1)
	     (if (custom-add-parent-links widget "Parent groups:")
		 (insert "\n")))
	   (insert-char ?\s (* custom-buffer-indent (1- level)))
	   ;; Create tag.
	   (let ((start (point)))
	     (insert tag " group: ")
	     (widget-specify-sample widget start (point)))
	   (cond
	    ((not doc)
	     (insert " Group definition missing. "))
	    ((< (length doc) 50)
	     (insert doc)))
	   ;; Create visibility indicator.
	   (unless (eq custom-buffer-style 'links)
	     (insert "--------")
	     (push (widget-create-child-and-convert
		    widget 'visibility
		    :help-echo "Hide members of this group."
		    :action 'custom-toggle-parent
		    (not (eq state 'hidden)))
		   buttons)
	     (insert " "))
	   (insert "\n")
	   ;; Create magic button.
	   (let ((magic (widget-create-child-and-convert
			 widget 'custom-magic
			 :indent 0
			 nil)))
	     (widget-put widget :custom-magic magic)
	     (push magic buttons))
	   ;; Update buttons.
	   (widget-put widget :buttons buttons)
	   ;; Insert documentation.
	   (when (and doc (>= (length doc) 50))
	     (widget-add-documentation-string-button
	      widget :visibility-widget 'custom-visibility))

	   ;; Parent groups.
	   (if nil  ;;; This should test that the buffer
		    ;;; was not made to display a group.
	       (when (eq level 1)
		 (insert-char ?\s custom-buffer-indent)
		 (custom-add-parent-links widget)))
	   (custom-add-see-also widget
				(make-string (* custom-buffer-indent level)
					     ?\s))
	   ;; Members.
	   (message "Creating group...")
           (let* ((members (custom--filter-obsolete-variables
                            (custom-sort-items
                             members
                             ;; Never sort the top-level custom group.
                             (unless (eq symbol 'emacs)
                               custom-buffer-sort-alphabetically)
                             custom-buffer-order-groups)))
		  (prefixes (widget-get widget :custom-prefixes))
		  (custom-prefix-list (custom-prefix-add symbol prefixes))
		  (have-subtitle (and (not (eq symbol 'emacs))
				      (eq custom-buffer-order-groups 'last)))
		  prev-type
		  children)

	     (dolist-with-progress-reporter (entry members) "Creating group entries..."
	       (unless (eq prev-type 'custom-group)
		 (widget-insert "\n"))
	       (let ((sym (nth 0 entry))
		     (type (nth 1 entry)))
		 (when (and have-subtitle (eq type 'custom-group))
		   (setq have-subtitle nil)
		   (widget-insert
		    (propertize "Subgroups:\n" 'face 'custom-group-subtitle)))
		 (setq prev-type type)
		 (push (widget-create-child-and-convert
			widget type
			:group widget
			:tag (custom-unlispify-tag-name sym)
			:custom-prefixes custom-prefix-list
			:custom-level (1+ level)
			:value sym)
		       children)
		 (unless (eq (preceding-char) ?\n)
		   (widget-insert "\n"))))

	     (setq children (nreverse children))
	     (mapc 'custom-magic-reset children)
	     (widget-put widget :children children)
	     (custom-group-state-update widget))
	   ;; End line
           (insert "\n")
           (custom-group--draw-horizontal-line)))))