+\f
+;;; Describing Custom themes.
+
+;;;###autoload
+(defun describe-theme (theme)
+ "Display a description of the Custom theme THEME (a symbol)."
+ (interactive
+ (list
+ (intern (completing-read "Describe custom theme: "
+ (mapcar 'symbol-name
+ (custom-available-themes))))))
+ (unless (custom-theme-name-valid-p theme)
+ (error "Invalid theme name `%s'" theme))
+ (help-setup-xref (list 'describe-theme theme)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (describe-theme-1 theme))))
+
+(defun describe-theme-1 (theme)
+ (prin1 theme)
+ (princ " is a custom theme")
+ (let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
+ (custom-theme--load-path)
+ '("" "c")))
+ doc)
+ (when fn
+ (princ " in `")
+ (help-insert-xref-button (file-name-nondirectory fn)
+ 'help-theme-def fn)
+ (princ "'"))
+ (princ ".\n")
+ (if (not (memq theme custom-known-themes))
+ (progn
+ (princ "It is not loaded.")
+ ;; Attempt to grab the theme documentation
+ (when fn
+ (with-temp-buffer
+ (insert-file-contents fn)
+ (let ((sexp (let ((read-circle nil))
+ (condition-case nil
+ (read (current-buffer))
+ (end-of-file nil)))))
+ (and sexp (listp sexp)
+ (eq (car sexp) 'deftheme)
+ (setq doc (nth 2 sexp)))))))
+ (if (custom-theme-enabled-p theme)
+ (princ "It is loaded and enabled.")
+ (princ "It is loaded but disabled."))
+ (setq doc (get theme 'theme-documentation)))
+
+ (princ "\n\nDocumentation:\n")
+ (princ (if (stringp doc)
+ doc
+ "No documentation available.")))
+ (princ "\n\nYou can ")
+ (help-insert-xref-button "customize" 'help-theme-edit theme)
+ (princ " this theme."))
+
+\f
+;;; Theme chooser
+
+(defvar custom--listed-themes)
+
+(defcustom custom-theme-allow-multiple-selections nil
+ "Whether to allow multi-selections in the *Custom Themes* buffer."
+ :type 'boolean
+ :group 'custom-buffer)
+
+(defvar custom-theme-choose-mode-map
+ (let ((map (make-keymap)))
+ (set-keymap-parent map widget-keymap)
+ (suppress-keymap map)
+ (define-key map "\C-x\C-s" 'custom-theme-save)
+ (define-key map "n" 'widget-forward)
+ (define-key map "p" 'widget-backward)
+ (define-key map "?" 'custom-describe-theme)
+ map)
+ "Keymap for `custom-theme-choose-mode'.")
+
+(define-derived-mode custom-theme-choose-mode nil "Themes"
+ "Major mode for selecting Custom themes.
+Do not call this mode function yourself. It is meant for internal use."
+ (use-local-map custom-theme-choose-mode-map)
+ (custom--initialize-widget-variables)
+ (set (make-local-variable 'revert-buffer-function)
+ (lambda (ignore-auto noconfirm)
+ (when (or noconfirm (y-or-n-p "Discard current choices? "))
+ (customize-themes (current-buffer))))))
+(put 'custom-theme-choose-mode 'mode-class 'special)
+
+;;;###autoload
+(defun customize-themes (&optional buffer)
+ "Display a selectable list of Custom themes.
+When called from Lisp, BUFFER should be the buffer to use; if
+omitted, a buffer named *Custom Themes* is used."
+ (interactive)
+ (switch-to-buffer (get-buffer-create (or buffer "*Custom Themes*")))
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (custom-theme-choose-mode)
+ (set (make-local-variable 'custom--listed-themes) nil)
+ (make-local-variable 'custom-theme-allow-multiple-selections)
+ (and (null custom-theme-allow-multiple-selections)
+ (> (length custom-enabled-themes) 1)
+ (setq custom-theme-allow-multiple-selections t))
+
+ (widget-insert
+ (substitute-command-keys
+ "Type RET or click to enable/disable listed custom themes.
+Type \\[custom-describe-theme] to describe the theme at point.
+Theme files are named *-theme.el in `"))
+ (widget-create 'link :value "custom-theme-load-path"
+ :button-face 'custom-link
+ :mouse-face 'highlight
+ :pressed-face 'highlight
+ :help-echo "Describe `custom-theme-load-path'."
+ :keymap custom-mode-link-map
+ :follow-link 'mouse-face
+ :action (lambda (widget &rest ignore)
+ (describe-variable 'custom-theme-load-path)))
+ (widget-insert "'.\n\n")
+
+ ;; If the user has made customizations, display a warning and
+ ;; provide buttons to disable or convert them.
+ (let ((user-settings (get 'user 'theme-settings)))
+ (unless (or (null user-settings)
+ (and (null (cdr user-settings))
+ (eq (caar user-settings) 'theme-value)
+ (eq (cadr (car user-settings)) 'custom-enabled-themes)))
+ (widget-insert
+ (propertize
+ " Note: Your custom settings take precedence over theme settings.
+ To migrate your settings into a theme, click "
+ 'face 'font-lock-warning-face))
+ (widget-create 'link :value "here"
+ :button-face 'custom-link
+ :mouse-face 'highlight
+ :pressed-face 'highlight
+ :help-echo "Migrate."
+ :keymap custom-mode-link-map
+ :follow-link 'mouse-face
+ :action (lambda (widget &rest ignore)
+ (customize-create-theme 'user)))
+ (widget-insert ".\n\n")))
+
+ (widget-create 'push-button
+ :tag " Save Theme Settings "
+ :help-echo "Save the selected themes for future sessions."
+ :action 'custom-theme-save)
+ (widget-insert ?\n)
+ (widget-create 'checkbox
+ :value custom-theme-allow-multiple-selections
+ :action 'custom-theme-selections-toggle)
+ (widget-insert (propertize " Allow more than one theme at a time"
+ 'face '(variable-pitch (:height 0.9))))
+
+ (widget-insert "\n\nAvailable Custom Themes:\n")
+ (let (widget)
+ (dolist (theme (custom-available-themes))
+ (setq widget (widget-create 'checkbox
+ :value (custom-theme-enabled-p theme)
+ :theme-name theme
+ :action 'custom-theme-checkbox-toggle))
+ (push (cons theme widget) custom--listed-themes)
+ (widget-create-child-and-convert widget 'push-button
+ :button-face-get 'ignore
+ :mouse-face-get 'ignore
+ :value (format " %s" theme)
+ :action 'widget-parent-action)
+ (widget-insert ?\n)))
+ (goto-char (point-min))
+ (widget-setup))
+
+(defun custom-theme-checkbox-toggle (widget &optional event)
+ (let ((this-theme (widget-get widget :theme-name)))
+ (if (widget-value widget)
+ ;; Disable the theme.
+ (progn
+ (disable-theme this-theme)
+ (widget-toggle-action widget event))
+ ;; Enable the theme.
+ (unless custom-theme-allow-multiple-selections
+ ;; If only one theme is allowed, disable all other themes and
+ ;; uncheck their boxes.
+ (dolist (theme custom-enabled-themes)
+ (and (not (eq theme this-theme))
+ (assq theme custom--listed-themes)
+ (disable-theme theme)))
+ (dolist (theme custom--listed-themes)
+ (unless (eq (car theme) this-theme)
+ (widget-value-set (cdr theme) nil)
+ (widget-apply (cdr theme) :notify (cdr theme) event))))
+ (when (load-theme this-theme)
+ (widget-toggle-action widget event)))
+ ;; Mark `custom-enabled-themes' as "set for current session".
+ (put 'custom-enabled-themes 'customized-value
+ (list (custom-quote custom-enabled-themes)))))
+
+(defun custom-describe-theme ()
+ "Describe the Custom theme on the current line."
+ (interactive)
+ (let ((widget (widget-at (line-beginning-position))))
+ (and widget
+ (describe-theme (widget-get widget :theme-name)))))
+
+(defun custom-theme-save (&rest ignore)
+ (interactive)
+ (customize-save-variable 'custom-enabled-themes custom-enabled-themes)
+ (message "Custom themes saved for future sessions."))
+
+(defun custom-theme-selections-toggle (widget &optional event)
+ (when (widget-value widget)
+ ;; Deactivate multiple-selections.
+ (if (< 1 (length (delq nil (mapcar (lambda (x) (widget-value (cdr x)))
+ custom--listed-themes))))
+ (error "More than one theme is currently selected")))
+ (widget-toggle-action widget event)
+ (setq custom-theme-allow-multiple-selections (widget-value widget)))
+