Mercurial > emacs

changeset 110938:17bbe431e616

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
New interface for choosing Custom themes. * lisp/cus-edit.el (custom--initialize-widget-variables): New function. (Custom-mode): Use it. * lisp/cus-face.el (custom-theme-set-faces): Remove dead code. Obey custom--inhibit-theme-enable. * lisp/cus-theme.el (describe-theme, customize-themes) (custom-theme-save): New commands. (custom-new-theme-mode-map): Bind C-x C-s. (custom-new-theme-mode): Use custom--initialize-widget-variables. (customize-create-theme): New optional arg THEME. (custom-theme-revert): Use it. (custom-theme-visit-theme): Remove dead code. (custom-theme-merge-theme): Use custom-available-themes. (custom-theme-write): Make interactive. (custom-theme-write): Use custom-theme-name-valid-p. (describe-theme-1, custom-theme-choose-revert) (custom-theme-checkbox-toggle, custom-theme-selections-toggle): New funs. (custom-theme-allow-multiple-selections): New option. (custom-theme-choose-mode): New major mode. * lisp/custom.el (custom-theme-set-variables): Remove dead code. Obey custom--inhibit-theme-enable. (custom--inhibit-theme-enable): New var. (provide-theme): Obey it. (load-theme): Replace load with manual read/eval, in order to check for correctness. Use custom-theme-name-valid-p. (custom-theme-name-valid-p): New function. (custom-available-themes): Use it. * lisp/help-mode.el (help-theme-def, help-theme-edit): New buttons.
author Chong Yidong <cyd@stupidchicken.com>
date Mon, 11 Oct 2010 23:10:21 -0400
parents 51080327d173
children 3cc0fb6085b0
files lisp/ChangeLog lisp/cus-edit.el lisp/cus-face.el lisp/cus-theme.el lisp/custom.el lisp/help-mode.el
diffstat 6 files changed, 415 insertions(+), 152 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Tue Oct 12 04:45:24 2010 +0200
+++ b/lisp/ChangeLog	Mon Oct 11 23:10:21 2010 -0400
@@ -1,3 +1,38 @@
+2010-10-12  Chong Yidong  <cyd@stupidchicken.com>
+
+	* cus-theme.el (describe-theme, customize-themes)
+	(custom-theme-save): New commands.
+	(custom-new-theme-mode-map): Bind C-x C-s.
+	(custom-new-theme-mode): Use custom--initialize-widget-variables.
+	(customize-create-theme): New optional arg THEME.
+	(custom-theme-revert): Use it.
+	(custom-theme-visit-theme): Remove dead code.
+	(custom-theme-merge-theme): Use custom-available-themes.
+	(custom-theme-write): Make interactive.
+	(custom-theme-write): Use custom-theme-name-valid-p.
+	(describe-theme-1, custom-theme-choose-revert)
+	(custom-theme-checkbox-toggle, custom-theme-selections-toggle):
+	New funs.
+	(custom-theme-allow-multiple-selections): New option.
+	(custom-theme-choose-mode): New major mode.
+
+	* custom.el (custom-theme-set-variables): Remove dead code.  Obey
+	custom--inhibit-theme-enable.
+	(custom--inhibit-theme-enable): New var.
+	(provide-theme): Obey it.
+	(load-theme): Replace load with manual read/eval, in order to
+	check for correctness.  Use custom-theme-name-valid-p.
+	(custom-theme-name-valid-p): New function.
+	(custom-available-themes): Use it.
+
+	* cus-edit.el (custom--initialize-widget-variables): New function.
+	(Custom-mode): Use it.
+
+	* cus-face.el (custom-theme-set-faces): Remove dead code.  Obey
+	custom--inhibit-theme-enable.
+
+	* help-mode.el (help-theme-def, help-theme-edit): New buttons.
+
 2010-10-12  Juanma Barranquero  <lekktu@gmail.com>
 
 	* net/telnet.el (telnet-mode-map): Fix previous change (bug#7193).
--- a/lisp/cus-edit.el	Tue Oct 12 04:45:24 2010 +0200
+++ b/lisp/cus-edit.el	Mon Oct 11 23:10:21 2010 -0400
@@ -439,9 +439,6 @@
 ;;; Custom mode keymaps
 
 (defvar custom-mode-map
-  ;; This keymap should be dense, but a dense keymap would prevent inheriting
-  ;; "\r" bindings from the parent map.
-  ;; Actually, this misfeature of dense keymaps was fixed on 2001-11-26.
   (let ((map (make-keymap)))
     (set-keymap-parent map widget-keymap)
     (define-key map [remap self-insert-command] 'Custom-no-edit)
@@ -4706,6 +4703,25 @@
   (if (eq (widget-get (widget-get widget :parent) :custom-state) 'modified)
       (message "To install your edits, invoke [State] and choose the Set operation")))
 
+(defun custom--initialize-widget-variables ()
+  (set (make-local-variable 'widget-documentation-face) 'custom-documentation)
+  (set (make-local-variable 'widget-button-face) custom-button)
+  (set (make-local-variable 'widget-button-pressed-face) custom-button-pressed)
+  (set (make-local-variable 'widget-mouse-face) custom-button-mouse)
+  ;; We need this because of the "More" button on docstrings.
+  ;; Otherwise clicking on "More" can push point offscreen, which
+  ;; causes the window to recenter on point, which pushes the
+  ;; newly-revealed docstring offscreen; which is annoying.  -- cyd.
+  (set (make-local-variable 'widget-button-click-moves-point) t)
+  ;; When possible, use relief for buttons, not bracketing.  This test
+  ;; may not be optimal.
+  (when custom-raised-buttons
+    (set (make-local-variable 'widget-push-button-prefix) "")
+    (set (make-local-variable 'widget-push-button-suffix) "")
+    (set (make-local-variable 'widget-link-prefix) "")
+    (set (make-local-variable 'widget-link-suffix) ""))
+  (setq show-trailing-whitespace nil))
+
 (define-derived-mode Custom-mode nil "Custom"
   "Major mode for editing customization buffers.
 
@@ -4743,28 +4759,7 @@
 	     (setq custom-tool-bar-map map))))
   (make-local-variable 'custom-options)
   (make-local-variable 'custom-local-buffer)
-  (make-local-variable 'widget-documentation-face)
-  (setq widget-documentation-face 'custom-documentation)
-  (make-local-variable 'widget-button-face)
-  (setq widget-button-face custom-button)
-  (setq show-trailing-whitespace nil)
-
-  ;; We need this because of the "More" button on docstrings.
-  ;; Otherwise clicking on "More" can push point offscreen, which
-  ;; causes the window to recenter on point, which pushes the
-  ;; newly-revealed docstring offscreen; which is annoying.  -- cyd.
-  (set (make-local-variable 'widget-button-click-moves-point) t)
-
-  (set (make-local-variable 'widget-button-pressed-face) custom-button-pressed)
-  (set (make-local-variable 'widget-mouse-face) custom-button-mouse)
-
-  ;; When possible, use relief for buttons, not bracketing.  This test
-  ;; may not be optimal.
-  (when custom-raised-buttons
-    (set (make-local-variable 'widget-push-button-prefix) "")
-    (set (make-local-variable 'widget-push-button-suffix) "")
-    (set (make-local-variable 'widget-link-prefix) "")
-    (set (make-local-variable 'widget-link-suffix) ""))
+  (custom--initialize-widget-variables)
   (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t))
 
 (put 'Custom-mode 'mode-class 'special)
--- a/lisp/cus-face.el	Tue Oct 12 04:45:24 2010 +0200
+++ b/lisp/cus-face.el	Mon Oct 11 23:10:21 2010 -0400
@@ -319,42 +319,32 @@
 FACE's list property `theme-face' \(using `custom-push-theme')."
   (custom-check-theme theme)
   (let ((immediate (get theme 'theme-immediate)))
-    (while args
-      (let ((entry (car args)))
-	(if (listp entry)
-	    (let ((face (nth 0 entry))
-		  (spec (nth 1 entry))
-		  (now (nth 2 entry))
-		  (comment (nth 3 entry))
-		  oldspec)
-	      ;; If FACE is actually an alias, customize the face it
-	      ;; is aliased to.
-	      (if (get face 'face-alias)
-		  (setq face (get face 'face-alias)))
-
-	      (setq oldspec (get face 'theme-face))
-	      (when (not (and oldspec (eq 'user (caar oldspec))))
-		(put face 'saved-face spec)
-		(put face 'saved-face-comment comment))
-
-	      (custom-push-theme 'theme-face face theme 'set spec)
-	      (when (or now immediate)
-		(put face 'force-face (if now 'rogue 'immediate)))
-	      (when (or now immediate (facep face))
-		(unless (facep face)
-		  (make-empty-face face))
-		(put face 'face-comment comment)
-		(put face 'face-override-spec nil)
-		(face-spec-set face spec t))
-	      (setq args (cdr args)))
-	  ;; Old format, a plist of FACE SPEC pairs.
-	  (let ((face (nth 0 args))
-		(spec (nth 1 args)))
-	    (if (get face 'face-alias)
-		(setq face (get face 'face-alias)))
-	    (put face 'saved-face spec)
-	    (custom-push-theme 'theme-face face theme 'set spec))
-	  (setq args (cdr (cdr args))))))))
+    (dolist (entry args)
+      (unless (listp entry)
+	(error "Incompatible Custom theme spec"))
+      (let ((face (car entry))
+	    (spec (nth 1 entry)))
+	;; If FACE is actually an alias, customize the face it
+	;; is aliased to.
+	(if (get face 'face-alias)
+	    (setq face (get face 'face-alias)))
+	(custom-push-theme 'theme-face face theme 'set spec)
+	(unless custom--inhibit-theme-enable
+	  ;; Now set the face spec.
+	  (let ((now (nth 2 entry))
+		(comment (nth 3 entry))
+		(oldspec (get face 'theme-face)))
+	    (when (not (and oldspec (eq 'user (caar oldspec))))
+	      (put face 'saved-face spec)
+	      (put face 'saved-face-comment comment))
+	    (when (or now immediate)
+	      (put face 'force-face (if now 'rogue 'immediate)))
+	    (when (or now immediate (facep face))
+	      (unless (facep face)
+		(make-empty-face face))
+	      (put face 'face-comment comment)
+	      (put face 'face-override-spec nil)
+	      (face-spec-set face spec t))))))))
 
 ;; XEmacs compability function.  In XEmacs, when you reset a Custom
 ;; Theme, you have to specify the theme to reset it to.  We just apply
--- a/lisp/cus-theme.el	Tue Oct 12 04:45:24 2010 +0200
+++ b/lisp/cus-theme.el	Mon Oct 11 23:10:21 2010 -0400
@@ -35,27 +35,18 @@
   (let ((map (make-keymap)))
     (set-keymap-parent map widget-keymap)
     (suppress-keymap map)
+    (define-key map "\C-x\C-s" 'custom-theme-write)
     (define-key map "n" 'widget-forward)
     (define-key map "p" 'widget-backward)
     map)
   "Keymap for `custom-new-theme-mode'.")
 
-(define-derived-mode custom-new-theme-mode nil "New-Theme"
-  "Major mode for the buffer created by `customize-create-theme'.
-Do not call this mode function yourself.  It is only meant for internal
-use by `customize-create-theme'."
+(define-derived-mode custom-new-theme-mode nil "Cus-Theme"
+  "Major mode for editing Custom themes.
+Do not call this mode function yourself.  It is meant for internal use."
   (use-local-map custom-new-theme-mode-map)
-  (define-key custom-new-theme-mode-map [mouse-1] 'widget-move-and-invoke)
-  (set (make-local-variable 'widget-documentation-face) 'custom-documentation)
-  (set (make-local-variable 'widget-button-face) custom-button)
-  (set (make-local-variable 'widget-button-pressed-face) custom-button-pressed)
-  (set (make-local-variable 'widget-mouse-face) custom-button-mouse)
-  (set (make-local-variable 'revert-buffer-function) 'custom-theme-revert)
-  (when custom-raised-buttons
-    (set (make-local-variable 'widget-push-button-prefix) "")
-    (set (make-local-variable 'widget-push-button-suffix) "")
-    (set (make-local-variable 'widget-link-prefix) "")
-    (set (make-local-variable 'widget-link-suffix) "")))
+  (custom--initialize-widget-variables)
+  (set (make-local-variable 'revert-buffer-function) 'custom-theme-revert))
 (put 'custom-new-theme-mode 'mode-class 'special)
 
 (defvar custom-theme-name nil)
@@ -82,17 +73,21 @@
   query-replace)
   "Faces listed by default in the *Custom Theme* buffer.")
 
+(defvar custom-theme--save-name)
+
 ;;;###autoload
-(defun customize-create-theme (&optional buffer)
-  "Create a custom theme.
+(defun customize-create-theme (&optional theme buffer)
+  "Create or edit a custom theme.
+THEME, if non-nil, should be an existing theme to edit.
 BUFFER, if non-nil, should be a buffer to use."
   (interactive)
-  (switch-to-buffer (or buffer (generate-new-buffer "*Custom Theme*")))
+  (switch-to-buffer (get-buffer-create (or buffer "*Custom Theme*")))
   ;; Save current faces
   (let ((inhibit-read-only t))
     (erase-buffer))
   (custom-new-theme-mode)
   (make-local-variable 'custom-theme-name)
+  (set (make-local-variable 'custom-theme--save-name) theme)
   (set (make-local-variable 'custom-theme-faces) nil)
   (set (make-local-variable 'custom-theme-variables) nil)
   (set (make-local-variable 'custom-theme-description) "")
@@ -116,7 +111,8 @@
 
   (widget-insert "\n\nTheme name : ")
   (setq custom-theme-name
-	(widget-create 'editable-field))
+	(widget-create 'editable-field
+		       :value (if theme (symbol-name theme) "")))
   (widget-insert "Description: ")
   (setq custom-theme-description
 	(widget-create 'text
@@ -164,14 +160,15 @@
 		 :action (lambda (widget &optional event)
 			   (call-interactively 'custom-theme-add-variable)))
   (widget-insert ?\n)
+  (if theme
+      (custom-theme-merge-theme theme))
   (widget-setup)
   (goto-char (point-min))
   (message ""))
 
 (defun custom-theme-revert (ignore-auto noconfirm)
   (when (or noconfirm (y-or-n-p "Discard current changes? "))
-    (erase-buffer)
-    (customize-create-theme (current-buffer))))
+    (customize-create-theme custom-theme--save-name (current-buffer))))
 
 ;;; Theme variables
 
@@ -318,10 +315,8 @@
 
 (defun custom-theme-visit-theme ()
   (interactive)
-  (when (or (and (null custom-theme-variables)
-		 (null custom-theme-faces))
-	    (and (y-or-n-p "Discard current changes? ")
-		 (progn (revert-buffer) t)))
+  (when (and (y-or-n-p "Discard current changes? ")
+	     (progn (revert-buffer) t))
     (let ((theme (call-interactively 'custom-theme-merge-theme)))
       (unless (eq theme 'user)
 	(widget-value-set custom-theme-name (symbol-name theme)))
@@ -331,9 +326,14 @@
       (widget-setup))))
 
 (defun custom-theme-merge-theme (theme)
-  (interactive "SCustom theme name: ")
-  (unless (eq theme 'user)
-    (load-theme theme))
+  (interactive
+   (list
+    (intern (completing-read "Merge custom theme: "
+			     (mapcar 'symbol-name
+				     (custom-available-themes))))))
+  (unless (custom-theme-name-valid-p theme)
+    (error "Invalid theme name `%s'" theme))
+  (load-theme theme)
   (let ((settings (get theme 'theme-settings)))
     (dolist (setting settings)
       (if (eq (car setting) 'theme-value)
@@ -343,6 +343,7 @@
   theme)
 
 (defun custom-theme-write (&rest ignore)
+  (interactive)
   (let* ((name (widget-value custom-theme-name))
 	 (doc (widget-value custom-theme-description))
 	 (vars  custom-theme-variables)
@@ -351,12 +352,8 @@
     (when (string-equal name "")
       (setq name (read-from-minibuffer "Theme name: " (user-login-name)))
       (widget-value-set custom-theme-name name))
-    (cond ((or (string-equal name "")
-	       (string-equal name "user")
-	       (string-equal name "changed"))
-	   (error "Custom themes cannot be named `%s'" name))
-	  ((string-match " " name)
-	   (error "Custom theme names should not contain spaces")))
+    (unless (custom-theme-name-valid-p (intern name))
+      (error "Custom themes cannot be named `%s'" name))
 
     (setq filename (expand-file-name (concat name "-theme.el")
 				     custom-theme-directory))
@@ -384,7 +381,8 @@
     (dolist (face custom-theme-faces)
       (when (widget-get (cdr face) :children)
 	(widget-put (cdr face) :custom-state 'saved)
-	(custom-redraw-magic (cdr face))))))
+	(custom-redraw-magic (cdr face))))
+    (message "Theme written to %s" filename)))
 
 (defun custom-theme-write-variables (theme vars)
   "Write a `custom-theme-set-variables' command for THEME.
@@ -456,5 +454,196 @@
       (unless (looking-at "\n")
 	(princ "\n")))))
 
+
+;;; 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")
+			 (cons custom-theme-directory load-path)
+			 '("" "c"))))
+    (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))
+      (princ "It is not loaded.")
+    (if (custom-theme-enabled-p theme)
+	(princ "It is loaded and enabled.\n")
+      (princ "It is loaded but disabled.\n"))
+    (princ "\nDocumentation:\n")
+    (princ (or (get theme 'theme-documentation)
+	       "No documentation available.")))
+  (princ "\n\nYou can ")
+  (help-insert-xref-button "customize" 'help-theme-edit theme)
+  (princ " this theme."))
+
+
+;;; 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 "Cus-Theme"
+  "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)
+  (pop-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 `"))
+  (when (stringp custom-theme-directory)
+    (widget-create 'link :value custom-theme-directory
+		   :button-face 'custom-link
+		   :mouse-face 'highlight
+		   :pressed-face 'highlight
+		   :help-echo "Describe `custom-theme-directory'."
+		   :keymap custom-mode-link-map
+		   :follow-link 'mouse-face
+		   :action (lambda (widget &rest ignore)
+			     (describe-variable 'custom-theme-directory)))
+    (widget-insert "' or `"))
+  (widget-create 'link :value "load-path"
+		 :button-face 'custom-link
+		 :mouse-face 'highlight
+		 :pressed-face 'highlight
+		 :help-echo "Describe `load-path'."
+		 :keymap custom-mode-link-map
+		 :follow-link 'mouse-face
+		 :action (lambda (widget &rest ignore)
+			   (describe-variable 'load-path)))
+  (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.
+	(disable-theme this-theme)
+      ;; 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))))
+      (load-theme this-theme)))
+  ;; Mark `custom-enabled-themes' as "set for current session".
+  (put 'custom-enabled-themes 'customized-value
+       (list (custom-quote custom-enabled-themes)))
+  ;; Check/uncheck the widget.
+  (widget-toggle-action widget event))
+
+(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 (> (length (delq nil (mapcar (lambda (x) (widget-value (cdr x)))
+				     custom--listed-themes)))
+	   1)
+	(error "More than one theme is currently selected")))
+  (widget-toggle-action widget event)
+  (setq custom-theme-allow-multiple-selections (widget-value widget)))
+
 ;; arch-tag: cd6919bc-63af-410e-bae2-b6702e762344
 ;;; cus-theme.el ends here
--- a/lisp/custom.el	Tue Oct 12 04:45:24 2010 +0200
+++ b/lisp/custom.el	Mon Oct 11 23:10:21 2010 -0400
@@ -959,48 +959,39 @@
 			(t (or (nth 3 a2)
                                (eq (get sym2 'custom-set)
                                    'custom-set-minor-mode))))))))
-  (while args
-    (let ((entry (car args)))
-      (if (listp entry)
-	  (let* ((symbol (indirect-variable (nth 0 entry)))
-		 (value (nth 1 entry))
-		 (now (nth 2 entry))
-		 (requests (nth 3 entry))
-		 (comment (nth 4 entry))
-		 set)
-	    (when requests
-	      (put symbol 'custom-requests requests)
-	      (mapc 'require requests))
-	    (setq set (or (get symbol 'custom-set) 'custom-set-default))
-	    (put symbol 'saved-value (list value))
-	    (put symbol 'saved-variable-comment comment)
-	    (custom-push-theme 'theme-value symbol theme 'set value)
-	    ;; Allow for errors in the case where the setter has
-	    ;; changed between versions, say, but let the user know.
-	    (condition-case data
-		(cond (now
-		       ;; Rogue variable, set it now.
-		       (put symbol 'force-value t)
-		       (funcall set symbol (eval value)))
-		      ((default-boundp symbol)
-		       ;; Something already set this, overwrite it.
-		       (funcall set symbol (eval value))))
-	      (error
-	       (message "Error setting %s: %s" symbol data)))
-	    (setq args (cdr args))
-	    (and (or now (default-boundp symbol))
-		 (put symbol 'variable-comment comment)))
-        ;; I believe this is dead-code, because the `sort' code above would
-        ;; have burped before we could get here.  --Stef
-	;; Old format, a plist of SYMBOL VALUE pairs.
-	(message "Warning: old format `custom-set-variables'")
-	(ding)
-	(sit-for 2)
-	(let ((symbol (indirect-variable (nth 0 args)))
-	      (value (nth 1 args)))
+
+  (dolist (entry args)
+    (unless (listp entry)
+      (error "Incompatible Custom theme spec"))
+    (let* ((symbol (indirect-variable (nth 0 entry)))
+	   (value (nth 1 entry)))
+      (custom-push-theme 'theme-value symbol theme 'set value)
+      (unless custom--inhibit-theme-enable
+	;; Now set the variable.
+	(let* ((now (nth 2 entry))
+	       (requests (nth 3 entry))
+	       (comment (nth 4 entry))
+	       set)
+	  (when requests
+	    (put symbol 'custom-requests requests)
+	    (mapc 'require requests))
+	  (setq set (or (get symbol 'custom-set) 'custom-set-default))
 	  (put symbol 'saved-value (list value))
-	  (custom-push-theme 'theme-value symbol theme 'set value))
-	(setq args (cdr (cdr args)))))))
+	  (put symbol 'saved-variable-comment comment)
+	  ;; Allow for errors in the case where the setter has
+	  ;; changed between versions, say, but let the user know.
+	  (condition-case data
+	      (cond (now
+		     ;; Rogue variable, set it now.
+		     (put symbol 'force-value t)
+		     (funcall set symbol (eval value)))
+		    ((default-boundp symbol)
+		     ;; Something already set this, overwrite it.
+		     (funcall set symbol (eval value))))
+	    (error
+	     (message "Error setting %s: %s" symbol data)))
+	  (and (or now (default-boundp symbol))
+	       (put symbol 'variable-comment comment)))))))
 
 
 ;;; Defining themes.
@@ -1072,6 +1063,12 @@
   :group 'customize
   :version "22.1")
 
+(defvar custom--inhibit-theme-enable nil
+  "If non-nil, loading a theme does not enable it.
+This internal variable is set by `load-theme' when its NO-ENABLE
+argument is non-nil, and it affects `custom-theme-set-variables',
+`custom-theme-set-faces', and `provide-theme'." )
+
 (defun provide-theme (theme)
   "Indicate that this file provides THEME.
 This calls `provide' to provide the feature name stored in THEME's
@@ -1081,35 +1078,83 @@
       (error "Custom theme cannot be named %S" theme))
   (custom-check-theme theme)
   (provide (get theme 'theme-feature))
-  ;; Loading a theme also enables it.
-  (push theme custom-enabled-themes)
-  ;; `user' must always be the highest-precedence enabled theme.
-  ;; Make that remain true.  (This has the effect of making user settings
-  ;; override the ones just loaded, too.)
-  (let ((custom-enabling-themes t))
-    (enable-theme 'user)))
+  (unless custom--inhibit-theme-enable
+    ;; Loading a theme also enables it.
+    (push theme custom-enabled-themes)
+    ;; `user' must always be the highest-precedence enabled theme.
+    ;; Make that remain true.  (This has the effect of making user settings
+    ;; override the ones just loaded, too.)
+    (let ((custom-enabling-themes t))
+      (enable-theme 'user))))
 
-(defun load-theme (theme)
+(defun load-theme (theme &optional no-enable)
   "Load a theme's settings from its file.
-This also enables the theme; use `disable-theme' to disable it."
+Normally, this also enables the theme; use `disable-theme' to
+disable it.  If optional arg NO-ENABLE is non-nil, don't enable
+the theme."
   ;; Note we do no check for validity of the theme here.
   ;; This allows to pull in themes by a file-name convention
   (interactive
    (list
     (intern (completing-read "Load custom theme: "
-			     (mapcar 'symbol-name (custom-available-themes))))))
+			     (mapcar 'symbol-name
+				     (custom-available-themes))))))
+  (unless (custom-theme-name-valid-p theme)
+    (error "Invalid theme name `%s'" theme))
   ;; If reloading, clear out the old theme settings.
   (when (custom-theme-p theme)
     (disable-theme theme)
     (put theme 'theme-settings nil)
     (put theme 'theme-feature nil)
     (put theme 'theme-documentation nil))
-  (let ((load-path (if (file-directory-p custom-theme-directory)
-		       (cons custom-theme-directory load-path)
-		     load-path)))
-    (load (symbol-name (custom-make-theme-feature theme)))))
+  (let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
+			 (cons custom-theme-directory load-path)
+			 '("" "c"))))
+    (unless fn
+      (error "Unable to find theme file for `%s'." theme))
+    ;; Instead of simply loading the theme file, read it manually.
+    (with-temp-buffer
+      (insert-file-contents fn)
+      (let ((custom--inhibit-theme-enable no-enable)
+	    sexp scar)
+	(while (setq sexp (let ((read-circle nil))
+			    (condition-case nil
+				(read (current-buffer))
+			      (end-of-file nil))))
+	  ;; Perform some checks on each sexp before evaluating it.
+	  (cond
+	   ((not (listp sexp)))
+	   ((eq (setq scar (car sexp)) 'deftheme)
+	    (unless (eq (cadr sexp) theme)
+	      (error "Incorrect theme name in `deftheme'"))
+	    (and (symbolp (nth 1 sexp))
+		 (stringp (nth 2 sexp))
+		 (eval (list scar (nth 1 sexp) (nth 2 sexp)))))
+	   ((or (eq scar 'custom-theme-set-variables)
+		(eq scar 'custom-theme-set-faces))
+	    (unless (equal (nth 1 sexp) `(quote ,theme))
+	      (error "Incorrect theme name in theme settings"))
+	    (dolist (entry (cddr sexp))
+	      (unless (eq (car-safe entry) 'quote)
+		(error "Unsafe expression in theme settings")))
+	    (eval sexp))
+	   ((and (eq scar 'provide-theme)
+		 (equal (cadr sexp) `(quote ,theme))
+		 (= (length sexp) 2))
+	    (eval sexp))))))))
+
+(defun custom-theme-name-valid-p (name)
+  "Return t if NAME is a valid name for a Custom theme, nil otherwise.
+NAME should be a symbol."
+  (and (symbolp name)
+       name
+       (not (or (zerop (length (symbol-name name)))
+		(eq name 'cus)
+		(eq name 'user)
+		(eq name 'changed)))))
 
 (defun custom-available-themes ()
+  "Return a list of available Custom themes (symbols)."
   (let* ((load-path (if (file-directory-p custom-theme-directory)
 			(cons custom-theme-directory load-path)
 		      load-path))
@@ -1120,7 +1165,7 @@
 	(setq file (file-name-nondirectory file))
 	(and (string-match "\\`\\(.+\\)-theme.el\\'" file)
 	     (setq sym (intern (match-string 1 file)))
-	     (not (memq sym '(cus user changed color)))
+	     (custom-theme-name-valid-p sym)
 	     (push sym themes))))
     (delete-dups themes)))
 
--- a/lisp/help-mode.el	Tue Oct 12 04:45:24 2010 +0200
+++ b/lisp/help-mode.el	Mon Oct 11 23:10:21 2010 -0400
@@ -255,6 +255,15 @@
   'help-function (lambda (file) (dired file))
   'help-echo (purecopy "mouse-2, RET: visit package directory"))
 
+(define-button-type 'help-theme-def
+  :supertype 'help-xref
+  'help-function 'find-file
+  'help-echo (purecopy "mouse-2, RET: visit theme file"))
+
+(define-button-type 'help-theme-edit
+  :supertype 'help-xref
+  'help-function 'customize-create-theme
+  'help-echo (purecopy "mouse-2, RET: edit this theme file"))
 
 ;;;###autoload
 (defun help-mode ()