Add 2012 to FSF copyright years for Emacs files

[bpt/emacs.git] / lisp / cus-theme.el

diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index 86fb43b..e662d8c 100644 (file)
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -1,6 +1,6 @@
 ;;; cus-theme.el -- custom theme creation user interface
 ;;
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
 ;;
 ;; Author: Alex Schroeder <alex@gnu.org>
 ;; Maintainer: FSF
@@ -157,7 +157,7 @@ remove them from your saved Custom file.\n\n"))
     ;; Load the theme settings.
     (when theme
       (unless (eq theme 'user)
-       (load-theme theme t))
+       (load-theme theme nil t))
       (dolist (setting (get theme 'theme-settings))
        (if (eq (car setting) 'theme-value)
            (progn (push (nth 1 setting) vars)
@@ -326,7 +326,7 @@ SPEC, if non-nil, should be a face spec to which to set the widget."
   (unless (eq theme 'user)
     (unless (custom-theme-name-valid-p theme)
       (error "Invalid theme name `%s'" theme))
-    (load-theme theme t))
+    (load-theme theme nil t))
   (let ((settings (reverse (get theme 'theme-settings))))
     (dolist (setting settings)
       (funcall (if (eq (car setting) 'theme-value)
@@ -483,25 +483,24 @@ It includes all faces in list FACES."
                               'help-theme-def fn)
       (princ "'"))
     (princ ".\n")
-    (if (not (memq theme custom-known-themes))
+    (if (custom-theme-p theme)
        (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)))
-
+         (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 "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)))))))
     (princ "\n\nDocumentation:\n")
     (princ (if (stringp doc)
               doc
@@ -522,7 +521,8 @@ It includes all faces in list FACES."
 
 (defvar custom-theme-choose-mode-map
   (let ((map (make-keymap)))
-    (set-keymap-parent map widget-keymap)
+    (set-keymap-parent map (make-composed-keymap widget-keymap
+                                                special-mode-map))
     (suppress-keymap map)
     (define-key map "\C-x\C-s" 'custom-theme-save)
     (define-key map "n" 'widget-forward)
@@ -531,7 +531,7 @@ It includes all faces in list FACES."
     map)
   "Keymap for `custom-theme-choose-mode'.")
 
-(define-derived-mode custom-theme-choose-mode nil "Themes"
+(define-derived-mode custom-theme-choose-mode special-mode "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)
@@ -605,26 +605,56 @@ Theme files are named *-theme.el in `"))
   (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"
+  (widget-insert (propertize " Select more than one theme at a time"
                             'face '(variable-pitch (:height 0.9))))
 
   (widget-insert "\n\nAvailable Custom Themes:\n")
-  (let (widget)
+  (let ((help-echo "mouse-2: Enable this theme for this session")
+       widget)
     (dolist (theme (custom-available-themes))
       (setq widget (widget-create 'checkbox
                                  :value (custom-theme-enabled-p theme)
                                  :theme-name theme
+                                 :help-echo help-echo
                                  :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)))
+                                      :action 'widget-parent-action
+                                      :help-echo help-echo)
+      (widget-insert " -- "
+                    (propertize (custom-theme-summary theme)
+                                'face 'shadow)
+                    ?\n)))
   (goto-char (point-min))
   (widget-setup))
 
+(defun custom-theme-summary (theme)
+  "Return the summary line of THEME."
+  (let (doc)
+    (if (custom-theme-p theme)
+       (setq doc (get theme 'theme-documentation))
+      (let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
+                            (custom-theme--load-path)
+                            '("" "c"))))
+       (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))))))))
+    (cond ((null doc)
+          "(no documentation available)")
+         ((string-match ".*" doc)
+          (match-string 0 doc))
+         (t doc))))
+
 (defun custom-theme-checkbox-toggle (widget &optional event)
   (let ((this-theme (widget-get widget :theme-name)))
     (if (widget-value widget)