lisp/cus-theme.el

   1 ;;; cus-theme.el -- custom theme creation user interface
   2 ;;
   3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005,
   4 ;;   2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   5 ;;
   6 ;; Author: Alex Schroeder <alex@gnu.org>
   7 ;; Maintainer: FSF
   8 ;; Keywords: help, faces
   9 ;; Package: emacs
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Code:
  27
  28 (require 'widget)
  29 (require 'cus-edit)
  30
  31 (eval-when-compile
  32   (require 'wid-edit))
  33
  34 (defvar custom-new-theme-mode-map
  35   (let ((map (make-keymap)))
  36     (set-keymap-parent map widget-keymap)
  37     (suppress-keymap map)
  38     (define-key map "\C-x\C-s" 'custom-theme-write)
  39     (define-key map "n" 'widget-forward)
  40     (define-key map "p" 'widget-backward)
  41     map)
  42   "Keymap for `custom-new-theme-mode'.")
  43
  44 (define-derived-mode custom-new-theme-mode nil "Custom-Theme"
  45   "Major mode for editing Custom themes.
  46 Do not call this mode function yourself.  It is meant for internal use."
  47   (use-local-map custom-new-theme-mode-map)
  48   (custom--initialize-widget-variables)
  49   (set (make-local-variable 'revert-buffer-function) 'custom-theme-revert))
  50 (put 'custom-new-theme-mode 'mode-class 'special)
  51
  52 (defvar custom-theme-name nil)
  53 ;; Each element has the form (VAR CHECKBOX-WIDGET VAR-WIDGET)
  54 (defvar custom-theme-variables nil)
  55 ;; Each element has the form (FACE CHECKBOX-WIDGET FACE-WIDGET)
  56 (defvar custom-theme-faces nil)
  57 (defvar custom-theme-description nil)
  58 (defvar custom-theme--migrate-settings nil)
  59 (defvar custom-theme-insert-variable-marker nil)
  60 (defvar custom-theme-insert-face-marker nil)
  61
  62 (defvar custom-theme--listed-faces '(default cursor fixed-pitch
  63   variable-pitch escape-glyph minibuffer-prompt highlight region
  64   shadow secondary-selection trailing-whitespace
  65   font-lock-builtin-face font-lock-comment-delimiter-face
  66   font-lock-comment-face font-lock-constant-face
  67   font-lock-doc-face font-lock-function-name-face
  68   font-lock-keyword-face font-lock-negation-char-face
  69   font-lock-preprocessor-face font-lock-regexp-grouping-backslash
  70   font-lock-regexp-grouping-construct font-lock-string-face
  71   font-lock-type-face font-lock-variable-name-face
  72   font-lock-warning-face button link link-visited fringe
  73   header-line tooltip mode-line mode-line-buffer-id
  74   mode-line-emphasis mode-line-highlight mode-line-inactive
  75   isearch isearch-fail lazy-highlight match next-error
  76   query-replace)
  77   "Faces listed by default in the *Custom Theme* buffer.")
  78
  79 (defvar custom-theme--save-name)
  80
  81 ;;;###autoload
  82 (defun customize-create-theme (&optional theme buffer)
  83   "Create or edit a custom theme.
  84 THEME, if non-nil, should be an existing theme to edit.  If THEME
  85 is `user', provide an option to remove these as custom settings.
  86 BUFFER, if non-nil, should be a buffer to use; the default is
  87 named *Custom Theme*."
  88   (interactive)
  89   (switch-to-buffer (get-buffer-create (or buffer "*Custom Theme*")))
  90   (let ((inhibit-read-only t))
  91     (erase-buffer)
  92     (dolist (ov (overlays-in (point-min) (point-max)))
  93       (delete-overlay ov)))
  94   (custom-new-theme-mode)
  95   (make-local-variable 'custom-theme-name)
  96   (set (make-local-variable 'custom-theme--save-name) theme)
  97   (set (make-local-variable 'custom-theme-faces) nil)
  98   (set (make-local-variable 'custom-theme-variables) nil)
  99   (set (make-local-variable 'custom-theme-description) "")
 100   (set (make-local-variable 'custom-theme--migrate-settings) nil)
 101   (make-local-variable 'custom-theme-insert-face-marker)
 102   (make-local-variable 'custom-theme-insert-variable-marker)
 103   (make-local-variable 'custom-theme--listed-faces)
 104
 105   (if (eq theme 'user)
 106       (widget-insert "This buffer contains all the Custom settings you have made.
 107 You can convert them into a new custom theme, and optionally
 108 remove them from your saved Custom file.\n\n"))
 109
 110   (widget-create 'push-button
 111                  :tag " Visit Theme "
 112                  :help-echo "Insert the settings of a pre-defined theme."
 113                  :action (lambda (widget &optional event)
 114                            (call-interactively 'custom-theme-visit-theme)))
 115   (widget-insert "  ")
 116   (widget-create 'push-button
 117                  :tag " Merge Theme "
 118                  :help-echo "Merge in the settings of a pre-defined theme."
 119                  :action (lambda (widget &optional event)
 120                            (call-interactively 'custom-theme-merge-theme)))
 121   (widget-insert "  ")
 122   (widget-create 'push-button
 123                  :tag " Revert "
 124                  :help-echo "Revert this buffer to its original state."
 125                  :action (lambda (&rest ignored) (revert-buffer)))
 126
 127   (widget-insert "\n\nTheme name : ")
 128   (setq custom-theme-name
 129         (widget-create 'editable-field
 130                        :value (if (and theme (not (eq theme 'user)))
 131                                   (symbol-name theme)
 132                                 "")))
 133   (widget-insert "Description: ")
 134   (setq custom-theme-description
 135         (widget-create 'text
 136                        :value (format-time-string "Created %Y-%m-%d.")))
 137   (widget-create 'push-button
 138                  :notify (function custom-theme-write)
 139                  " Save Theme ")
 140   (when (eq theme 'user)
 141     (setq custom-theme--migrate-settings t)
 142     (widget-insert "  ")
 143     (widget-create 'checkbox
 144                    :value custom-theme--migrate-settings
 145                    :action (lambda (widget &optional event)
 146                              (when (widget-value widget)
 147                                (widget-toggle-action widget event)
 148                                (setq custom-theme--migrate-settings
 149                                      (widget-value widget)))))
 150     (widget-insert (propertize " Remove saved theme settings from Custom save file."
 151                                'face '(variable-pitch (:height 0.9)))))
 152
 153   (let (vars values faces face-specs)
 154
 155     ;; Load the theme settings.
 156     (when theme
 157       (unless (eq theme 'user)
 158         (load-theme theme t))
 159       (dolist (setting (get theme 'theme-settings))
 160         (if (eq (car setting) 'theme-value)
 161             (progn (push (nth 1 setting) vars)
 162                    (push (nth 3 setting) values))
 163           (push (nth 1 setting) faces)
 164           (push (nth 3 setting) face-specs))))
 165
 166     ;; If THEME is non-nil, insert all of that theme's faces.
 167     ;; Otherwise, insert those in `custom-theme--listed-faces'.
 168     (widget-insert "\n\n  Theme faces:\n ")
 169     (if theme
 170         (while faces
 171           (custom-theme-add-face-1 (pop faces) (pop face-specs)))
 172       (dolist (face custom-theme--listed-faces)
 173         (custom-theme-add-face-1 face nil)))
 174     (setq custom-theme-insert-face-marker (point-marker))
 175     (widget-insert " ")
 176     (widget-create 'push-button
 177                    :tag "Insert Additional Face"
 178                    :help-echo "Add another face to this theme."
 179                    :follow-link 'mouse-face
 180                    :button-face 'custom-link
 181                    :mouse-face 'highlight
 182                    :pressed-face 'highlight
 183                    :action (lambda (widget &optional event)
 184                              (call-interactively 'custom-theme-add-face)))
 185
 186     ;; If THEME is non-nil, insert all of that theme's variables.
 187     (widget-insert "\n\n  Theme variables:\n ")
 188     (if theme
 189         (while vars
 190           (if (eq (car vars) 'custom-enabled-themes)
 191               (progn (pop vars) (pop values))
 192             (custom-theme-add-var-1 (pop vars) (pop values)))))
 193     (setq custom-theme-insert-variable-marker (point-marker))
 194     (widget-insert " ")
 195     (widget-create 'push-button
 196                    :tag "Insert Variable"
 197                    :help-echo "Add another variable to this theme."
 198                    :follow-link 'mouse-face
 199                    :button-face 'custom-link
 200                    :mouse-face 'highlight
 201                    :pressed-face 'highlight
 202                    :action (lambda (widget &optional event)
 203                              (call-interactively 'custom-theme-add-variable)))
 204     (widget-insert ?\n)
 205     (widget-setup)
 206     (goto-char (point-min))
 207     (message "")))
 208
 209 (defun custom-theme-revert (ignore-auto noconfirm)
 210   (when (or noconfirm (y-or-n-p "Discard current changes? "))
 211     (customize-create-theme custom-theme--save-name (current-buffer))))
 212
 213 ;;; Theme variables
 214
 215 (defun custom-theme-add-variable (var value)
 216   "Add a widget for VAR (a symbol) to the *New Custom Theme* buffer.
 217 VALUE should be a value to which to set the widget; when called
 218 interactively, this defaults to the current value of VAR."
 219   (interactive
 220    (let ((v (read-variable "Variable name: ")))
 221      (list v (symbol-value v))))
 222   (let ((entry (assq var custom-theme-variables)))
 223     (cond ((null entry)
 224            ;; If VAR is not yet in the buffer, add it.
 225            (save-excursion
 226              (goto-char custom-theme-insert-variable-marker)
 227              (custom-theme-add-var-1 var value)
 228              (move-marker custom-theme-insert-variable-marker (point))
 229              (widget-setup)))
 230           ;; Otherwise, alter that var widget.
 231           (t
 232            (widget-value-set (nth 1 entry) t)
 233            (let ((widget (nth 2 entry)))
 234              (widget-put widget :shown-value (list value))
 235              (custom-redraw widget))))))
 236
 237 (defun custom-theme-add-var-1 (symbol val)
 238   (widget-insert " ")
 239   (push (list symbol
 240               (prog1 (widget-create 'checkbox
 241                                     :value t
 242                                     :help-echo "Enable/disable this variable.")
 243                 (widget-insert " "))
 244               (widget-create 'custom-variable
 245                              :tag (custom-unlispify-tag-name symbol)
 246                              :value symbol
 247                              :shown-value (list val)
 248                              :notify 'ignore
 249                              :custom-level 0
 250                              :custom-state 'hidden
 251                              :custom-style 'simple))
 252         custom-theme-variables)
 253   (widget-insert " "))
 254
 255 ;;; Theme faces
 256
 257 (defun custom-theme-add-face (face &optional spec)
 258   "Add a widget for FACE (a symbol) to the *New Custom Theme* buffer.
 259 SPEC, if non-nil, should be a face spec to which to set the widget."
 260   (interactive (list (read-face-name "Face name" nil nil) nil))
 261   (unless (or (facep face) spec)
 262     (error "`%s' has no face definition" face))
 263   (let ((entry (assq face custom-theme-faces)))
 264     (cond ((null entry)
 265            ;; If FACE is not yet in the buffer, add it.
 266            (save-excursion
 267              (goto-char custom-theme-insert-face-marker)
 268              (custom-theme-add-face-1 face spec)
 269              (move-marker custom-theme-insert-face-marker (point))
 270              (widget-setup)))
 271           ;; Otherwise, if SPEC is supplied, alter that face widget.
 272           (spec
 273            (widget-value-set (nth 1 entry) t)
 274            (let ((widget (nth 2 entry)))
 275              (widget-put widget :shown-value spec)
 276              (custom-redraw widget)))
 277           ((called-interactively-p 'interactive)
 278            (error "`%s' is already present" face)))))
 279
 280 (defun custom-theme-add-face-1 (symbol spec)
 281   (widget-insert " ")
 282   (push (list symbol
 283               (prog1
 284                   (widget-create 'checkbox
 285                                  :value t
 286                                  :help-echo "Enable/disable this face.")
 287                 (widget-insert " "))
 288               (widget-create 'custom-face
 289                              :tag (custom-unlispify-tag-name symbol)
 290                              :documentation-shown t
 291                              :value symbol
 292                              :custom-state 'hidden
 293                              :custom-style 'simple
 294                              :shown-value spec
 295                              :sample-indent 34))
 296         custom-theme-faces)
 297   (widget-insert " "))
 298
 299 ;;; Reading and writing
 300
 301 (defun custom-theme-visit-theme (theme)
 302   "Load the custom theme THEME's settings into the current buffer."
 303   (interactive
 304    (list
 305     (intern (completing-read "Find custom theme: "
 306                              (mapcar 'symbol-name
 307                                      (custom-available-themes))))))
 308   (unless (custom-theme-name-valid-p theme)
 309     (error "No valid theme named `%s'" theme))
 310   (cond ((not (eq major-mode 'custom-new-theme-mode))
 311          (customize-create-theme theme))
 312         ((y-or-n-p "Discard current changes? ")
 313          (setq custom-theme--save-name theme)
 314          (custom-theme-revert nil t))))
 315
 316 (defun custom-theme-merge-theme (theme)
 317   "Merge the custom theme THEME's settings into the current buffer."
 318   (interactive
 319    (list
 320     (intern (completing-read "Merge custom theme: "
 321                              (mapcar 'symbol-name
 322                                      (custom-available-themes))))))
 323   (unless (eq theme 'user)
 324     (unless (custom-theme-name-valid-p theme)
 325       (error "Invalid theme name `%s'" theme))
 326     (load-theme theme t))
 327   (let ((settings (reverse (get theme 'theme-settings))))
 328     (dolist (setting settings)
 329       (funcall (if (eq (car setting) 'theme-value)
 330                    'custom-theme-add-variable
 331                  'custom-theme-add-face)
 332                (nth 1 setting)
 333                (nth 3 setting))))
 334   theme)
 335
 336 (defun custom-theme-write (&rest ignore)
 337   "Write the current custom theme to its theme file."
 338   (interactive)
 339   (let* ((name (widget-value custom-theme-name))
 340          (doc  (widget-value custom-theme-description))
 341          (vars custom-theme-variables)
 342          (faces custom-theme-faces)
 343          filename)
 344     (when (string-equal name "")
 345       (setq name (read-from-minibuffer "Theme name: " (user-login-name)))
 346       (widget-value-set custom-theme-name name))
 347     (unless (custom-theme-name-valid-p (intern name))
 348       (error "Custom themes cannot be named `%s'" name))
 349
 350     (setq filename (expand-file-name (concat name "-theme.el")
 351                                      custom-theme-directory))
 352     (and (file-exists-p filename)
 353          (not (y-or-n-p (format "File %s exists.  Overwrite? " filename)))
 354          (error "Aborted"))
 355
 356     (with-temp-buffer
 357       (emacs-lisp-mode)
 358       (unless (file-directory-p custom-theme-directory)
 359         (make-directory (file-name-as-directory custom-theme-directory) t))
 360       (setq buffer-file-name filename)
 361       (erase-buffer)
 362       (insert "(deftheme " name)
 363       (if doc (insert "\n  \"" doc "\""))
 364       (insert  ")\n")
 365       (custom-theme-write-variables name (reverse vars))
 366       (custom-theme-write-faces name (reverse faces))
 367       (insert "\n(provide-theme '" name ")\n")
 368       (save-buffer))
 369     (message "Theme written to %s" filename)
 370
 371     (when custom-theme--migrate-settings
 372       ;; Remove these settings from the Custom file.
 373       (let ((custom-reset-standard-variables-list '(t))
 374             (custom-reset-standard-faces-list '(t)))
 375         (dolist (var vars)
 376           (when (and (not (eq (car var) 'custom-enabled-themes))
 377                      (widget-get (nth 1 var) :value))
 378             (widget-apply (nth 2 var) :custom-mark-to-reset-standard)))
 379         (dolist (face faces)
 380           (when (widget-get (nth 1 face) :value)
 381             (widget-apply (nth 2 face) :custom-mark-to-reset-standard)))
 382         (custom-save-all))
 383       (let ((custom-theme-load-path (list 'custom-theme-directory)))
 384         (load-theme (intern name))))))
 385
 386 (defun custom-theme-write-variables (theme vars)
 387   "Write a `custom-theme-set-variables' command for THEME.
 388 It includes all variables in list VARS."
 389   (when vars
 390     (let ((standard-output (current-buffer)))
 391       (princ "\n(custom-theme-set-variables\n")
 392       (princ " '")
 393       (princ theme)
 394       (princ "\n")
 395       (dolist (spec vars)
 396         (when (widget-get (nth 1 spec) :value)
 397           (let* ((symbol (nth 0 spec))
 398                  (widget (nth 2 spec))
 399                  (child (car-safe (widget-get widget :children)))
 400                  (value (if child
 401                             (widget-value child)
 402                           ;; Child is null if the widget is closed (hidden).
 403                           (car (widget-get widget :shown-value)))))
 404             (when (boundp symbol)
 405               (unless (bolp)
 406                 (princ "\n"))
 407               (princ " '(")
 408               (prin1 symbol)
 409               (princ " ")
 410               (prin1 (custom-quote value))
 411               (princ ")")))))
 412       (if (bolp)
 413           (princ " "))
 414       (princ ")")
 415       (unless (looking-at "\n")
 416         (princ "\n")))))
 417
 418 (defun custom-theme-write-faces (theme faces)
 419   "Write a `custom-theme-set-faces' command for THEME.
 420 It includes all faces in list FACES."
 421   (when faces
 422     (let ((standard-output (current-buffer)))
 423       (princ "\n(custom-theme-set-faces\n")
 424       (princ " '")
 425       (princ theme)
 426       (princ "\n")
 427       (dolist (spec faces)
 428         (when (widget-get (nth 1 spec) :value)
 429           (let* ((symbol (nth 0 spec))
 430                  (widget (nth 2 spec))
 431                  (value
 432                   (if (car-safe (widget-get widget :children))
 433                       (custom-face-widget-to-spec widget)
 434                     ;; Child is null if the widget is closed (hidden).
 435                     (widget-get widget :shown-value))))
 436             (when (and (facep symbol) value)
 437               (princ (if (bolp) " '(" "\n '("))
 438               (prin1 symbol)
 439               (princ " ")
 440               (prin1 value)
 441               (princ ")")))))
 442       (if (bolp) (princ " "))
 443       (princ ")")
 444       (unless (looking-at "\n")
 445         (princ "\n")))))
 446
 447 \f
 448 ;;; Describing Custom themes.
 449
 450 ;;;###autoload
 451 (defun describe-theme (theme)
 452   "Display a description of the Custom theme THEME (a symbol)."
 453   (interactive
 454    (list
 455     (intern (completing-read "Describe custom theme: "
 456                              (mapcar 'symbol-name
 457                                      (custom-available-themes))))))
 458   (unless (custom-theme-name-valid-p theme)
 459     (error "Invalid theme name `%s'" theme))
 460   (help-setup-xref (list 'describe-theme theme)
 461                    (called-interactively-p 'interactive))
 462   (with-help-window (help-buffer)
 463     (with-current-buffer standard-output
 464       (describe-theme-1 theme))))
 465
 466 (defun describe-theme-1 (theme)
 467   (prin1 theme)
 468   (princ " is a custom theme")
 469   (let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
 470                          (custom-theme--load-path)
 471                          '("" "c")))
 472         doc)
 473     (when fn
 474       (princ " in `")
 475       (help-insert-xref-button (file-name-nondirectory fn)
 476                                'help-theme-def fn)
 477       (princ "'"))
 478     (princ ".\n")
 479     (if (not (memq theme custom-known-themes))
 480         (progn
 481           (princ "It is not loaded.")
 482           ;; Attempt to grab the theme documentation
 483           (when fn
 484             (with-temp-buffer
 485               (insert-file-contents fn)
 486               (let ((sexp (let ((read-circle nil))
 487                             (condition-case nil
 488                                 (read (current-buffer))
 489                               (end-of-file nil)))))
 490                 (and sexp (listp sexp)
 491                      (eq (car sexp) 'deftheme)
 492                      (setq doc (nth 2 sexp)))))))
 493       (if (custom-theme-enabled-p theme)
 494           (princ "It is loaded and enabled.")
 495         (princ "It is loaded but disabled."))
 496       (setq doc (get theme 'theme-documentation)))
 497
 498     (princ "\n\nDocumentation:\n")
 499     (princ (if (stringp doc)
 500                doc
 501              "No documentation available.")))
 502   (princ "\n\nYou can ")
 503   (help-insert-xref-button "customize" 'help-theme-edit theme)
 504   (princ " this theme."))
 505
 506 \f
 507 ;;; Theme chooser
 508
 509 (defvar custom--listed-themes)
 510
 511 (defcustom custom-theme-allow-multiple-selections nil
 512   "Whether to allow multi-selections in the *Custom Themes* buffer."
 513   :type 'boolean
 514   :group 'custom-buffer)
 515
 516 (defvar custom-theme-choose-mode-map
 517   (let ((map (make-keymap)))
 518     (set-keymap-parent map widget-keymap)
 519     (suppress-keymap map)
 520     (define-key map "\C-x\C-s" 'custom-theme-save)
 521     (define-key map "n" 'widget-forward)
 522     (define-key map "p" 'widget-backward)
 523     (define-key map "?" 'custom-describe-theme)
 524     map)
 525   "Keymap for `custom-theme-choose-mode'.")
 526
 527 (define-derived-mode custom-theme-choose-mode nil "Themes"
 528   "Major mode for selecting Custom themes.
 529 Do not call this mode function yourself.  It is meant for internal use."
 530   (use-local-map custom-theme-choose-mode-map)
 531   (custom--initialize-widget-variables)
 532   (set (make-local-variable 'revert-buffer-function)
 533        (lambda (ignore-auto noconfirm)
 534          (when (or noconfirm (y-or-n-p "Discard current choices? "))
 535            (customize-themes (current-buffer))))))
 536 (put 'custom-theme-choose-mode 'mode-class 'special)
 537
 538 ;;;###autoload
 539 (defun customize-themes (&optional buffer)
 540   "Display a selectable list of Custom themes.
 541 When called from Lisp, BUFFER should be the buffer to use; if
 542 omitted, a buffer named *Custom Themes* is used."
 543   (interactive)
 544   (pop-to-buffer (get-buffer-create (or buffer "*Custom Themes*")))
 545   (let ((inhibit-read-only t))
 546     (erase-buffer))
 547   (custom-theme-choose-mode)
 548   (set (make-local-variable 'custom--listed-themes) nil)
 549   (make-local-variable 'custom-theme-allow-multiple-selections)
 550   (and (null custom-theme-allow-multiple-selections)
 551        (> (length custom-enabled-themes) 1)
 552        (setq custom-theme-allow-multiple-selections t))
 553
 554   (widget-insert
 555    (substitute-command-keys
 556     "Type RET or click to enable/disable listed custom themes.
 557 Type \\[custom-describe-theme] to describe the theme at point.
 558 Theme files are named *-theme.el in `"))
 559   (widget-create 'link :value "custom-theme-load-path"
 560                  :button-face 'custom-link
 561                  :mouse-face 'highlight
 562                  :pressed-face 'highlight
 563                  :help-echo "Describe `custom-theme-load-path'."
 564                  :keymap custom-mode-link-map
 565                  :follow-link 'mouse-face
 566                  :action (lambda (widget &rest ignore)
 567                            (describe-variable 'custom-theme-load-path)))
 568   (widget-insert "'.\n\n")
 569
 570   ;; If the user has made customizations, display a warning and
 571   ;; provide buttons to disable or convert them.
 572   (let ((user-settings (get 'user 'theme-settings)))
 573     (unless (or (null user-settings)
 574                 (and (null (cdr user-settings))
 575                      (eq (caar user-settings) 'theme-value)
 576                      (eq (cadr (car user-settings)) 'custom-enabled-themes)))
 577       (widget-insert
 578        (propertize
 579         " Note: Your custom settings take precedence over theme settings.
 580        To migrate your settings into a theme, click "
 581         'face 'font-lock-warning-face))
 582       (widget-create 'link :value "here"
 583                      :button-face 'custom-link
 584                      :mouse-face 'highlight
 585                      :pressed-face 'highlight
 586                      :help-echo "Migrate."
 587                      :keymap custom-mode-link-map
 588                      :follow-link 'mouse-face
 589                      :action (lambda (widget &rest ignore)
 590                                (customize-create-theme 'user)))
 591       (widget-insert ".\n\n")))
 592
 593   (widget-create 'push-button
 594                  :tag " Save Theme Settings "
 595                  :help-echo "Save the selected themes for future sessions."
 596                  :action 'custom-theme-save)
 597   (widget-insert ?\n)
 598   (widget-create 'checkbox
 599                  :value custom-theme-allow-multiple-selections
 600                  :action 'custom-theme-selections-toggle)
 601   (widget-insert (propertize " Allow more than one theme at a time"
 602                              'face '(variable-pitch (:height 0.9))))
 603
 604   (widget-insert "\n\nAvailable Custom Themes:\n")
 605   (let (widget)
 606     (dolist (theme (custom-available-themes))
 607       (setq widget (widget-create 'checkbox
 608                                   :value (custom-theme-enabled-p theme)
 609                                   :theme-name theme
 610                                   :action 'custom-theme-checkbox-toggle))
 611       (push (cons theme widget) custom--listed-themes)
 612       (widget-create-child-and-convert widget 'push-button
 613                                        :button-face-get 'ignore
 614                                        :mouse-face-get 'ignore
 615                                        :value (format " %s" theme)
 616                                        :action 'widget-parent-action)
 617       (widget-insert ?\n)))
 618   (goto-char (point-min))
 619   (widget-setup))
 620
 621 (defun custom-theme-checkbox-toggle (widget &optional event)
 622   (let ((this-theme (widget-get widget :theme-name)))
 623     (if (widget-value widget)
 624         ;; Disable the theme.
 625         (disable-theme this-theme)
 626       ;; Enable the theme.
 627       (unless custom-theme-allow-multiple-selections
 628         ;; If only one theme is allowed, disable all other themes and
 629         ;; uncheck their boxes.
 630         (dolist (theme custom-enabled-themes)
 631           (and (not (eq theme this-theme))
 632                (assq theme custom--listed-themes)
 633                (disable-theme theme)))
 634         (dolist (theme custom--listed-themes)
 635           (unless (eq (car theme) this-theme)
 636             (widget-value-set (cdr theme) nil)
 637             (widget-apply (cdr theme) :notify (cdr theme) event))))
 638       (load-theme this-theme)))
 639   ;; Mark `custom-enabled-themes' as "set for current session".
 640   (put 'custom-enabled-themes 'customized-value
 641        (list (custom-quote custom-enabled-themes)))
 642   ;; Check/uncheck the widget.
 643   (widget-toggle-action widget event))
 644
 645 (defun custom-describe-theme ()
 646   "Describe the Custom theme on the current line."
 647   (interactive)
 648   (let ((widget (widget-at (line-beginning-position))))
 649     (and widget
 650          (describe-theme (widget-get widget :theme-name)))))
 651
 652 (defun custom-theme-save (&rest ignore)
 653   (interactive)
 654   (customize-save-variable 'custom-enabled-themes custom-enabled-themes)
 655   (message "Custom themes saved for future sessions."))
 656
 657 (defun custom-theme-selections-toggle (widget &optional event)
 658   (when (widget-value widget)
 659     ;; Deactivate multiple-selections.
 660     (if (< 1 (length (delq nil (mapcar (lambda (x) (widget-value (cdr x)))
 661                                        custom--listed-themes))))
 662         (error "More than one theme is currently selected")))
 663   (widget-toggle-action widget event)
 664   (setq custom-theme-allow-multiple-selections (widget-value widget)))
 665
 666 ;; arch-tag: cd6919bc-63af-410e-bae2-b6702e762344
 667 ;;; cus-theme.el ends here