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