diff options
| -rw-r--r-- | lisp/ChangeLog | 20 | ||||
| -rw-r--r-- | lisp/cus-edit.el | 61 | ||||
| -rw-r--r-- | lisp/cus-theme.el | 397 |
3 files changed, 237 insertions, 241 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4097b914223..931ee696482 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,23 @@ | |||
| 1 | 2010-10-16 Chong Yidong <cyd@stupidchicken.com> | ||
| 2 | |||
| 3 | * cus-theme.el (customize-create-theme): Delete overlays after | ||
| 4 | erasing. If given a THEME arg, display only the faces of that arg | ||
| 5 | instead of custom-theme--listed-faces. | ||
| 6 | (custom-theme-variable-menu, custom-theme-variable-action) | ||
| 7 | (custom-variable-reset-theme, custom-theme-delete-variable): Deleted. | ||
| 8 | (custom-theme-add-variable, custom-theme-add-face): Apply value | ||
| 9 | from the theme settings, instead of the current value. | ||
| 10 | (custom-theme-add-var-1, custom-theme-add-face-1): New functions. | ||
| 11 | (custom-theme-visit-theme): Allow calling outside theme buffers. | ||
| 12 | (custom-theme-merge-theme): Don't enable the theme when merging. | ||
| 13 | (custom-theme-write-variables, custom-theme-write-faces): Use the | ||
| 14 | :shown-value properties to save buffer values, not global ones. | ||
| 15 | (customize-themes): Display a warning about user customizations. | ||
| 16 | |||
| 17 | * cus-edit.el (custom-variable-value-create) | ||
| 18 | (custom-face-value-create): Obey new special properties | ||
| 19 | :shown-value and :inhibit-magic. | ||
| 20 | |||
| 1 | 2010-10-15 Michael Albinus <michael.albinus@gmx.de> | 21 | 2010-10-15 Michael Albinus <michael.albinus@gmx.de> |
| 2 | 22 | ||
| 3 | * net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): | 23 | * net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): |
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index f7090bc322f..793b5cccedf 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el | |||
| @@ -2460,7 +2460,13 @@ The following properties have special meanings for this widget: | |||
| 2460 | :custom-form should be a symbol describing how to display and | 2460 | :custom-form should be a symbol describing how to display and |
| 2461 | edit the variable---either `edit' (using edit widgets), | 2461 | edit the variable---either `edit' (using edit widgets), |
| 2462 | `lisp' (as a Lisp sexp), or `mismatch' (should not happen); | 2462 | `lisp' (as a Lisp sexp), or `mismatch' (should not happen); |
| 2463 | if nil, use the return value of `custom-variable-default-form'." | 2463 | if nil, use the return value of `custom-variable-default-form'. |
| 2464 | |||
| 2465 | :shown-value, if non-nil, should be a list whose `car' is the | ||
| 2466 | variable value to display in place of the current value. | ||
| 2467 | |||
| 2468 | :inhibit-magic, if non-nil, inhibits creating the magic | ||
| 2469 | custom-state widget." | ||
| 2464 | :format "%v" | 2470 | :format "%v" |
| 2465 | :help-echo "Set or reset this variable." | 2471 | :help-echo "Set or reset this variable." |
| 2466 | :documentation-property #'custom-variable-documentation | 2472 | :documentation-property #'custom-variable-documentation |
| @@ -2512,9 +2518,12 @@ try matching its doc string against `custom-guess-doc-alist'." | |||
| 2512 | (get (or (get symbol 'custom-get) 'default-value)) | 2518 | (get (or (get symbol 'custom-get) 'default-value)) |
| 2513 | (prefix (widget-get widget :custom-prefix)) | 2519 | (prefix (widget-get widget :custom-prefix)) |
| 2514 | (last (widget-get widget :custom-last)) | 2520 | (last (widget-get widget :custom-last)) |
| 2515 | (value (if (default-boundp symbol) | 2521 | (value (let ((shown-value (widget-get widget :shown-value))) |
| 2516 | (funcall get symbol) | 2522 | (cond (shown-value |
| 2517 | (widget-get conv :value))) | 2523 | (car shown-value)) |
| 2524 | ((default-boundp symbol) | ||
| 2525 | (funcall get symbol)) | ||
| 2526 | (t (widget-get conv :value))))) | ||
| 2518 | (state (or (widget-get widget :custom-state) | 2527 | (state (or (widget-get widget :custom-state) |
| 2519 | (if (memq (custom-variable-state symbol value) | 2528 | (if (memq (custom-variable-state symbol value) |
| 2520 | (widget-get widget :hidden-states)) | 2529 | (widget-get widget :hidden-states)) |
| @@ -2622,10 +2631,11 @@ try matching its doc string against `custom-guess-doc-alist'." | |||
| 2622 | (unless (eq (preceding-char) ?\n) | 2631 | (unless (eq (preceding-char) ?\n) |
| 2623 | (widget-insert "\n")) | 2632 | (widget-insert "\n")) |
| 2624 | ;; Create the magic button. | 2633 | ;; Create the magic button. |
| 2625 | (let ((magic (widget-create-child-and-convert | 2634 | (unless (widget-get widget :inhibit-magic) |
| 2626 | widget 'custom-magic nil))) | 2635 | (let ((magic (widget-create-child-and-convert |
| 2627 | (widget-put widget :custom-magic magic) | 2636 | widget 'custom-magic nil))) |
| 2628 | (push magic buttons)) | 2637 | (widget-put widget :custom-magic magic) |
| 2638 | (push magic buttons))) | ||
| 2629 | (widget-put widget :buttons buttons) | 2639 | (widget-put widget :buttons buttons) |
| 2630 | ;; Insert documentation. | 2640 | ;; Insert documentation. |
| 2631 | (widget-put widget :documentation-indent 3) | 2641 | (widget-put widget :documentation-indent 3) |
| @@ -3281,12 +3291,17 @@ The following properties have special meanings for this widget: | |||
| 3281 | Lisp sexp), or `mismatch' (should not happen); if nil, use | 3291 | Lisp sexp), or `mismatch' (should not happen); if nil, use |
| 3282 | the return value of `custom-face-default-form'. | 3292 | the return value of `custom-face-default-form'. |
| 3283 | 3293 | ||
| 3284 | :display-style, if non-nil, should be a symbol describing the | 3294 | :display-style, if non-nil, describes the style of display to |
| 3285 | style of display to use. If the value is `concise', a more | 3295 | use. If the value is `concise', a neater interface is shown. |
| 3286 | concise interface is shown. | 3296 | |
| 3297 | :sample-indent, if non-nil, is the number of columns to which to | ||
| 3298 | indent the face sample (an integer). | ||
| 3287 | 3299 | ||
| 3288 | :sample-indent, if non-nil, should be an integer; this is the | 3300 | :shown-value, if non-nil, is the face spec to display as the value |
| 3289 | number of columns to which to indent the face sample." | 3301 | of the widget, instead of the current face spec. |
| 3302 | |||
| 3303 | :inhibit-magic, if non-nil, inhibits creating the magic | ||
| 3304 | custom-state widget." | ||
| 3290 | :sample-face 'custom-face-tag | 3305 | :sample-face 'custom-face-tag |
| 3291 | :help-echo "Set or reset this face." | 3306 | :help-echo "Set or reset this face." |
| 3292 | :documentation-property #'face-doc-string | 3307 | :documentation-property #'face-doc-string |
| @@ -3429,14 +3444,19 @@ WIDGET should be a `custom-face' widget." | |||
| 3429 | (indent-to-column sample-indent))) | 3444 | (indent-to-column sample-indent))) |
| 3430 | (push (widget-create-child-and-convert | 3445 | (push (widget-create-child-and-convert |
| 3431 | widget 'item | 3446 | widget 'item |
| 3432 | :format "[%{%t%}]" :sample-face symbol :tag "sample") | 3447 | :format "[%{%t%}]" |
| 3448 | :sample-face (let ((spec (widget-get widget :shown-value))) | ||
| 3449 | (if spec (face-spec-choose spec) symbol)) | ||
| 3450 | :tag "sample") | ||
| 3433 | buttons) | 3451 | buttons) |
| 3434 | ;; Magic. | ||
| 3435 | (insert "\n") | 3452 | (insert "\n") |
| 3436 | (let ((magic (widget-create-child-and-convert | 3453 | |
| 3437 | widget 'custom-magic nil))) | 3454 | ;; Magic. |
| 3438 | (widget-put widget :custom-magic magic) | 3455 | (unless (widget-get widget :inhibit-magic) |
| 3439 | (push magic buttons)) | 3456 | (let ((magic (widget-create-child-and-convert |
| 3457 | widget 'custom-magic nil))) | ||
| 3458 | (widget-put widget :custom-magic magic) | ||
| 3459 | (push magic buttons))) | ||
| 3440 | 3460 | ||
| 3441 | ;; Update buttons. | 3461 | ;; Update buttons. |
| 3442 | (widget-put widget :buttons buttons) | 3462 | (widget-put widget :buttons buttons) |
| @@ -3465,7 +3485,8 @@ WIDGET should be a `custom-face' widget." | |||
| 3465 | (unless (widget-get widget :custom-form) | 3485 | (unless (widget-get widget :custom-form) |
| 3466 | (widget-put widget :custom-form custom-face-default-form)) | 3486 | (widget-put widget :custom-form custom-face-default-form)) |
| 3467 | 3487 | ||
| 3468 | (let* ((spec (custom-face-get-current-spec symbol)) | 3488 | (let* ((spec (or (widget-get widget :shown-value) |
| 3489 | (custom-face-get-current-spec symbol))) | ||
| 3469 | (form (widget-get widget :custom-form)) | 3490 | (form (widget-get widget :custom-form)) |
| 3470 | (indent (widget-get widget :indent)) | 3491 | (indent (widget-get widget :indent)) |
| 3471 | face-alist face-entry spec-default spec-match editor) | 3492 | face-alist face-entry spec-default spec-match editor) |
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 197d9787d9a..241dd6cc069 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el | |||
| @@ -79,12 +79,14 @@ Do not call this mode function yourself. It is meant for internal use." | |||
| 79 | (defun customize-create-theme (&optional theme buffer) | 79 | (defun customize-create-theme (&optional theme buffer) |
| 80 | "Create or edit a custom theme. | 80 | "Create or edit a custom theme. |
| 81 | THEME, if non-nil, should be an existing theme to edit. | 81 | THEME, if non-nil, should be an existing theme to edit. |
| 82 | BUFFER, if non-nil, should be a buffer to use." | 82 | BUFFER, if non-nil, should be a buffer to use; the default is |
| 83 | named *Custom Theme*." | ||
| 83 | (interactive) | 84 | (interactive) |
| 84 | (switch-to-buffer (get-buffer-create (or buffer "*Custom Theme*"))) | 85 | (switch-to-buffer (get-buffer-create (or buffer "*Custom Theme*"))) |
| 85 | ;; Save current faces | ||
| 86 | (let ((inhibit-read-only t)) | 86 | (let ((inhibit-read-only t)) |
| 87 | (erase-buffer)) | 87 | (erase-buffer) |
| 88 | (dolist (ov (overlays-in (point-min) (point-max))) | ||
| 89 | (delete-overlay ov))) | ||
| 88 | (custom-new-theme-mode) | 90 | (custom-new-theme-mode) |
| 89 | (make-local-variable 'custom-theme-name) | 91 | (make-local-variable 'custom-theme-name) |
| 90 | (set (make-local-variable 'custom-theme--save-name) theme) | 92 | (set (make-local-variable 'custom-theme--save-name) theme) |
| @@ -121,50 +123,59 @@ BUFFER, if non-nil, should be a buffer to use." | |||
| 121 | (widget-create 'push-button | 123 | (widget-create 'push-button |
| 122 | :notify (function custom-theme-write) | 124 | :notify (function custom-theme-write) |
| 123 | " Save Theme ") | 125 | " Save Theme ") |
| 124 | ;; Face widgets | 126 | |
| 125 | (widget-insert "\n\n Theme faces:\n") | 127 | (let (vars values faces face-specs) |
| 126 | (let (widget) | 128 | |
| 127 | (dolist (face custom-theme--listed-faces) | 129 | ;; Load the theme settings. |
| 128 | (widget-insert " ") | 130 | (when theme |
| 129 | (setq widget (widget-create 'custom-face | 131 | (load-theme theme t) |
| 130 | :documentation-shown t | 132 | (dolist (setting (get theme 'theme-settings)) |
| 131 | :tag (custom-unlispify-tag-name face) | 133 | (if (eq (car setting) 'theme-value) |
| 132 | :value face | 134 | (progn (push (nth 1 setting) vars) |
| 133 | :display-style 'concise | 135 | (push (nth 3 setting) values)) |
| 134 | :custom-state 'hidden | 136 | (push (nth 1 setting) faces) |
| 135 | :sample-indent 34)) | 137 | (push (nth 3 setting) face-specs)))) |
| 136 | (custom-magic-reset widget) | 138 | |
| 137 | (push (cons face widget) custom-theme-faces))) | 139 | ;; If THEME is non-nil, insert all of that theme's faces. |
| 138 | (insert " ") | 140 | ;; Otherwise, insert those in `custom-theme--listed-faces'. |
| 139 | (setq custom-theme-insert-face-marker (point-marker)) | 141 | (widget-insert "\n\n Theme faces:\n ") |
| 140 | (insert " ") | 142 | (if theme |
| 141 | (widget-create 'push-button | 143 | (while faces |
| 142 | :tag "Insert Additional Face" | 144 | (custom-theme-add-face-1 (pop faces) (pop face-specs))) |
| 143 | :help-echo "Add another face to this theme." | 145 | (dolist (face custom-theme--listed-faces) |
| 144 | :follow-link 'mouse-face | 146 | (custom-theme-add-face-1 face nil))) |
| 145 | :button-face 'custom-link | 147 | (setq custom-theme-insert-face-marker (point-marker)) |
| 146 | :mouse-face 'highlight | 148 | (widget-insert " ") |
| 147 | :pressed-face 'highlight | 149 | (widget-create 'push-button |
| 148 | :action (lambda (widget &optional event) | 150 | :tag "Insert Additional Face" |
| 149 | (call-interactively 'custom-theme-add-face))) | 151 | :help-echo "Add another face to this theme." |
| 150 | (widget-insert "\n\n Theme variables:\n ") | 152 | :follow-link 'mouse-face |
| 151 | (setq custom-theme-insert-variable-marker (point-marker)) | 153 | :button-face 'custom-link |
| 152 | (widget-insert ?\s) | 154 | :mouse-face 'highlight |
| 153 | (widget-create 'push-button | 155 | :pressed-face 'highlight |
| 154 | :tag "Insert Variable" | 156 | :action (lambda (widget &optional event) |
| 155 | :help-echo "Add another variable to this theme." | 157 | (call-interactively 'custom-theme-add-face))) |
| 156 | :follow-link 'mouse-face | 158 | |
| 157 | :button-face 'custom-link | 159 | ;; If THEME is non-nil, insert all of that theme's variables. |
| 158 | :mouse-face 'highlight | 160 | (widget-insert "\n\n Theme variables:\n ") |
| 159 | :pressed-face 'highlight | 161 | (if theme |
| 160 | :action (lambda (widget &optional event) | 162 | (while vars |
| 161 | (call-interactively 'custom-theme-add-variable))) | 163 | (custom-theme-add-var-1 (pop vars) (pop values)))) |
| 162 | (widget-insert ?\n) | 164 | (setq custom-theme-insert-variable-marker (point-marker)) |
| 163 | (if theme | 165 | (widget-insert " ") |
| 164 | (custom-theme-merge-theme theme)) | 166 | (widget-create 'push-button |
| 165 | (widget-setup) | 167 | :tag "Insert Variable" |
| 166 | (goto-char (point-min)) | 168 | :help-echo "Add another variable to this theme." |
| 167 | (message "")) | 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 ""))) | ||
| 168 | 179 | ||
| 169 | (defun custom-theme-revert (ignore-auto noconfirm) | 180 | (defun custom-theme-revert (ignore-auto noconfirm) |
| 170 | (when (or noconfirm (y-or-n-p "Discard current changes? ")) | 181 | (when (or noconfirm (y-or-n-p "Discard current changes? ")) |
| @@ -172,177 +183,119 @@ BUFFER, if non-nil, should be a buffer to use." | |||
| 172 | 183 | ||
| 173 | ;;; Theme variables | 184 | ;;; Theme variables |
| 174 | 185 | ||
| 175 | (defun custom-theme-add-variable (symbol) | 186 | (defun custom-theme-add-variable (var value) |
| 176 | (interactive "vVariable name: ") | 187 | "Add a widget for VAR (a symbol) to the *New Custom Theme* buffer. |
| 177 | (cond ((assq symbol custom-theme-variables) | 188 | VALUE should be a value to which to set the widget; when called |
| 178 | (message "%s is already in the theme" (symbol-name symbol))) | 189 | interactively, this defaults to the current value of VAR." |
| 179 | ((not (boundp symbol)) | 190 | (interactive |
| 180 | (message "%s is not defined as a variable" (symbol-name symbol))) | 191 | (let ((v (read-variable "Variable name: "))) |
| 181 | ((eq symbol 'custom-enabled-themes) | 192 | (list v (symbol-value v)))) |
| 182 | (message "Custom theme cannot contain `custom-enabled-themes'")) | 193 | (let ((var-and-widget (assq var custom-theme-faces))) |
| 183 | (t | 194 | (cond ((null var-and-widget) |
| 184 | (save-excursion | 195 | ;; If VAR is not yet in the buffer, add it. |
| 185 | (goto-char custom-theme-insert-variable-marker) | 196 | (save-excursion |
| 186 | (widget-insert " ") | 197 | (goto-char custom-theme-insert-variable-marker) |
| 187 | (let ((widget (widget-create 'custom-variable | 198 | (custom-theme-add-var-1 var value) |
| 188 | :tag (custom-unlispify-tag-name symbol) | 199 | (move-marker custom-theme-insert-variable-marker (point)) |
| 189 | :custom-level 0 | 200 | (widget-setup))) |
| 190 | :action 'custom-theme-variable-action | 201 | ;; Otherwise, alter that var widget. |
| 191 | :custom-state 'unknown | 202 | (t |
| 192 | :value symbol))) | 203 | (let ((widget (cdr var-and-widget))) |
| 193 | (push (cons symbol widget) custom-theme-variables) | 204 | (widget-put widget :shown-value (list value)) |
| 194 | (custom-magic-reset widget)) | 205 | (custom-redraw widget)))))) |
| 195 | (widget-insert " ") | 206 | |
| 196 | (move-marker custom-theme-insert-variable-marker (point)) | 207 | (defun custom-theme-add-var-1 (symbol val) |
| 197 | (widget-setup))))) | 208 | (widget-insert " ") |
| 198 | 209 | (push (cons symbol | |
| 199 | (defvar custom-theme-variable-menu | 210 | (widget-create 'custom-variable |
| 200 | `(("Reset to Current" custom-redraw | 211 | :tag (custom-unlispify-tag-name symbol) |
| 201 | (lambda (widget) | 212 | :value symbol |
| 202 | (and (boundp (widget-value widget)) | 213 | :shown-value (list val) |
| 203 | (memq (widget-get widget :custom-state) | 214 | :notify 'ignore |
| 204 | '(themed modified changed))))) | 215 | :custom-level 0 |
| 205 | ("Reset to Theme Value" custom-variable-reset-theme | 216 | :custom-state 'hidden |
| 206 | (lambda (widget) | 217 | :inhibit-magic t)) |
| 207 | (let ((theme (intern (widget-value custom-theme-name))) | 218 | custom-theme-variables) |
| 208 | (symbol (widget-value widget)) | 219 | (widget-insert " ")) |
| 209 | found) | ||
| 210 | (and (custom-theme-p theme) | ||
| 211 | (dolist (setting (get theme 'theme-settings) found) | ||
| 212 | (if (and (eq (cadr setting) symbol) | ||
| 213 | (eq (car setting) 'theme-value)) | ||
| 214 | (setq found t))))))) | ||
| 215 | ("---" ignore ignore) | ||
| 216 | ("Delete" custom-theme-delete-variable nil)) | ||
| 217 | "Alist of actions for the `custom-variable' widget in Custom Theme Mode. | ||
| 218 | See the documentation for `custom-variable'.") | ||
| 219 | |||
| 220 | (defun custom-theme-variable-action (widget &optional event) | ||
| 221 | "Show the Custom Theme Mode menu for a `custom-variable' widget. | ||
| 222 | Optional EVENT is the location for the menu." | ||
| 223 | (let ((custom-variable-menu custom-theme-variable-menu)) | ||
| 224 | (custom-variable-action widget event))) | ||
| 225 | |||
| 226 | (defun custom-variable-reset-theme (widget) | ||
| 227 | "Reset WIDGET to its value for the currently edited theme." | ||
| 228 | (let ((theme (intern (widget-value custom-theme-name))) | ||
| 229 | (symbol (widget-value widget)) | ||
| 230 | found) | ||
| 231 | (dolist (setting (get theme 'theme-settings)) | ||
| 232 | (if (and (eq (cadr setting) symbol) | ||
| 233 | (eq (car setting) 'theme-value)) | ||
| 234 | (setq found setting))) | ||
| 235 | (widget-value-set (car (widget-get widget :children)) | ||
| 236 | (nth 3 found))) | ||
| 237 | (widget-put widget :custom-state 'themed) | ||
| 238 | (custom-redraw-magic widget) | ||
| 239 | (widget-setup)) | ||
| 240 | |||
| 241 | (defun custom-theme-delete-variable (widget) | ||
| 242 | (setq custom-theme-variables | ||
| 243 | (assq-delete-all (widget-value widget) custom-theme-variables)) | ||
| 244 | (widget-delete widget)) | ||
| 245 | 220 | ||
| 246 | ;;; Theme faces | 221 | ;;; Theme faces |
| 247 | 222 | ||
| 248 | (defun custom-theme-add-face (symbol) | 223 | (defun custom-theme-add-face (face &optional spec) |
| 249 | (interactive (list (read-face-name "Face name" nil nil))) | 224 | "Add a widget for FACE (a symbol) to the *New Custom Theme* buffer. |
| 250 | (cond ((assq symbol custom-theme-faces) | 225 | SPEC, if non-nil, should be a face spec to which to set the widget." |
| 251 | (message "%s is already in the theme" (symbol-name symbol))) | 226 | (interactive (list (read-face-name "Face name" nil nil) nil)) |
| 252 | ((not (facep symbol)) | 227 | (unless (or (facep face) spec) |
| 253 | (message "%s is not defined as a face" (symbol-name symbol))) | 228 | (error "`%s' has no face definition" face)) |
| 254 | (t | 229 | (let ((face-and-widget (assq face custom-theme-faces))) |
| 255 | (save-excursion | 230 | (cond ((null face-and-widget) |
| 256 | (goto-char custom-theme-insert-face-marker) | 231 | ;; If FACE is not yet in the buffer, add it. |
| 257 | (widget-insert " ") | 232 | (save-excursion |
| 258 | (let ((widget (widget-create 'custom-face | 233 | (goto-char custom-theme-insert-face-marker) |
| 259 | :tag (custom-unlispify-tag-name symbol) | 234 | (custom-theme-add-face-1 face spec) |
| 260 | :custom-level 0 | ||
| 261 | :action 'custom-theme-face-action | ||
| 262 | :custom-state 'unknown | ||
| 263 | :display-style 'concise | ||
| 264 | :sample-indent 34 | ||
| 265 | :value symbol))) | ||
| 266 | (push (cons symbol widget) custom-theme-faces) | ||
| 267 | (custom-magic-reset widget) | ||
| 268 | (widget-insert " ") | ||
| 269 | (move-marker custom-theme-insert-face-marker (point)) | 235 | (move-marker custom-theme-insert-face-marker (point)) |
| 270 | (widget-setup)))))) | 236 | (widget-setup))) |
| 271 | 237 | ;; Otherwise, if SPEC is supplied, alter that face widget. | |
| 272 | (defvar custom-theme-face-menu | 238 | (spec |
| 273 | `(("Reset to Theme Value" custom-face-reset-theme | 239 | (let ((widget (cdr face-and-widget))) |
| 274 | (lambda (widget) | 240 | (widget-put widget :shown-value spec) |
| 275 | (let ((theme (intern (widget-value custom-theme-name))) | 241 | (custom-redraw widget))) |
| 276 | (symbol (widget-value widget)) | 242 | ((called-interactively-p 'interactive) |
| 277 | found) | 243 | (error "`%s' is already present" face))))) |
| 278 | (and (custom-theme-p theme) | 244 | |
| 279 | (dolist (setting (get theme 'theme-settings) found) | 245 | (defun custom-theme-add-face-1 (symbol spec) |
| 280 | (if (and (eq (cadr setting) symbol) | 246 | (widget-insert " ") |
| 281 | (eq (car setting) 'theme-face)) | 247 | (push (cons symbol |
| 282 | (setq found t))))))) | 248 | (widget-create 'custom-face |
| 283 | ("---" ignore ignore) | 249 | :tag (custom-unlispify-tag-name symbol) |
| 284 | ("Delete" custom-theme-delete-face nil)) | 250 | :documentation-shown t |
| 285 | "Alist of actions for the `custom-variable' widget in Custom Theme Mode. | 251 | :value symbol |
| 286 | See the documentation for `custom-variable'.") | 252 | :custom-state 'hidden |
| 287 | 253 | :display-style 'concise | |
| 288 | (defun custom-theme-face-action (widget &optional event) | 254 | :shown-value spec |
| 289 | "Show the Custom Theme Mode menu for a `custom-face' widget. | 255 | :inhibit-magic t |
| 290 | Optional EVENT is the location for the menu." | 256 | :sample-indent 34)) |
| 291 | (let ((custom-face-menu custom-theme-face-menu)) | 257 | custom-theme-faces) |
| 292 | (custom-face-action widget event))) | 258 | (widget-insert " ")) |
| 293 | |||
| 294 | (defun custom-face-reset-theme (widget) | ||
| 295 | "Reset WIDGET to its value for the currently edited theme." | ||
| 296 | (let ((theme (intern (widget-value custom-theme-name))) | ||
| 297 | (symbol (widget-value widget)) | ||
| 298 | found) | ||
| 299 | (dolist (setting (get theme 'theme-settings)) | ||
| 300 | (if (and (eq (cadr setting) symbol) | ||
| 301 | (eq (car setting) 'theme-face)) | ||
| 302 | (setq found setting))) | ||
| 303 | (widget-value-set (car (widget-get widget :children)) | ||
| 304 | (nth 3 found))) | ||
| 305 | (widget-put widget :custom-state 'themed) | ||
| 306 | (custom-redraw-magic widget) | ||
| 307 | (widget-setup)) | ||
| 308 | |||
| 309 | (defun custom-theme-delete-face (widget) | ||
| 310 | (setq custom-theme-faces | ||
| 311 | (assq-delete-all (widget-value widget) custom-theme-faces)) | ||
| 312 | (widget-delete widget)) | ||
| 313 | 259 | ||
| 314 | ;;; Reading and writing | 260 | ;;; Reading and writing |
| 315 | 261 | ||
| 316 | (defun custom-theme-visit-theme () | 262 | (defun custom-theme-visit-theme (theme) |
| 317 | (interactive) | 263 | "Load the custom theme THEME's settings into the current buffer." |
| 318 | (when (and (y-or-n-p "Discard current changes? ") | 264 | (interactive |
| 319 | (progn (revert-buffer) t)) | 265 | (list |
| 320 | (let ((theme (call-interactively 'custom-theme-merge-theme))) | 266 | (intern (completing-read "Find custom theme: " |
| 321 | (unless (eq theme 'user) | 267 | (mapcar 'symbol-name |
| 322 | (widget-value-set custom-theme-name (symbol-name theme))) | 268 | (custom-available-themes)))))) |
| 323 | (widget-value-set custom-theme-description | 269 | (unless (custom-theme-name-valid-p theme) |
| 324 | (or (get theme 'theme-documentation) | 270 | (error "No valid theme named `%s'" theme)) |
| 325 | (format-time-string "Created %Y-%m-%d."))) | 271 | (cond ((not (eq major-mode 'custom-new-theme-mode)) |
| 326 | (widget-setup)))) | 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)))) | ||
| 327 | 276 | ||
| 328 | (defun custom-theme-merge-theme (theme) | 277 | (defun custom-theme-merge-theme (theme) |
| 278 | "Merge the custom theme THEME's settings into the current buffer." | ||
| 329 | (interactive | 279 | (interactive |
| 330 | (list | 280 | (list |
| 331 | (intern (completing-read "Merge custom theme: " | 281 | (intern (completing-read "Merge custom theme: " |
| 332 | (mapcar 'symbol-name | 282 | (mapcar 'symbol-name |
| 333 | (custom-available-themes)))))) | 283 | (custom-available-themes)))))) |
| 334 | (unless (custom-theme-name-valid-p theme) | 284 | (unless (eq theme 'user) |
| 335 | (error "Invalid theme name `%s'" theme)) | 285 | (unless (custom-theme-name-valid-p theme) |
| 336 | (load-theme theme) | 286 | (error "Invalid theme name `%s'" theme)) |
| 337 | (let ((settings (get theme 'theme-settings))) | 287 | (load-theme theme t)) |
| 288 | (let ((settings (reverse (get theme 'theme-settings)))) | ||
| 338 | (dolist (setting settings) | 289 | (dolist (setting settings) |
| 339 | (if (eq (car setting) 'theme-value) | 290 | (funcall (if (eq (car setting) 'theme-value) |
| 340 | (custom-theme-add-variable (cadr setting)) | 291 | 'custom-theme-add-variable |
| 341 | (custom-theme-add-face (cadr setting))))) | 292 | 'custom-theme-add-face) |
| 342 | (disable-theme theme) | 293 | (nth 1 setting) |
| 294 | (nth 3 setting)))) | ||
| 343 | theme) | 295 | theme) |
| 344 | 296 | ||
| 345 | (defun custom-theme-write (&rest ignore) | 297 | (defun custom-theme-write (&rest ignore) |
| 298 | "Write the current custom theme to its theme file." | ||
| 346 | (interactive) | 299 | (interactive) |
| 347 | (let* ((name (widget-value custom-theme-name)) | 300 | (let* ((name (widget-value custom-theme-name)) |
| 348 | (doc (widget-value custom-theme-description)) | 301 | (doc (widget-value custom-theme-description)) |
| @@ -395,11 +348,12 @@ It includes all variables in list VARS." | |||
| 395 | (princ "\n") | 348 | (princ "\n") |
| 396 | (dolist (spec vars) | 349 | (dolist (spec vars) |
| 397 | (let* ((symbol (car spec)) | 350 | (let* ((symbol (car spec)) |
| 398 | (child (car-safe (widget-get (cdr spec) :children))) | 351 | (widget (cdr spec)) |
| 352 | (child (car-safe (widget-get widget :children))) | ||
| 399 | (value (if child | 353 | (value (if child |
| 400 | (widget-value child) | 354 | (widget-value child) |
| 401 | ;; For hidden widgets, use the standard value | 355 | ;; Child is null if the widget is closed (hidden). |
| 402 | (get symbol 'standard-value)))) | 356 | (car (widget-get widget :shown-value))))) |
| 403 | (when (boundp symbol) | 357 | (when (boundp symbol) |
| 404 | (unless (bolp) | 358 | (unless (bolp) |
| 405 | (princ "\n")) | 359 | (princ "\n")) |
| @@ -426,30 +380,18 @@ It includes all faces in list FACES." | |||
| 426 | (dolist (spec faces) | 380 | (dolist (spec faces) |
| 427 | (let* ((symbol (car spec)) | 381 | (let* ((symbol (car spec)) |
| 428 | (widget (cdr spec)) | 382 | (widget (cdr spec)) |
| 429 | (child (car-safe (widget-get widget :children))) | ||
| 430 | (state (if child | ||
| 431 | (widget-get widget :custom-state) | ||
| 432 | (custom-face-state symbol))) | ||
| 433 | (value | 383 | (value |
| 434 | (cond ((eq state 'standard) | 384 | (if (car-safe (widget-get widget :children)) |
| 435 | nil) ; do nothing | 385 | (custom-face-widget-to-spec widget) |
| 436 | (child | 386 | ;; Child is null if the widget is closed (hidden). |
| 437 | (custom-face-widget-to-spec widget)) | 387 | (widget-get widget :shown-value)))) |
| 438 | (t | ||
| 439 | ;; Widget is closed (hidden), but the face has | ||
| 440 | ;; a non-standard value. Try to extract that | ||
| 441 | ;; value and save it. | ||
| 442 | (custom-face-get-current-spec symbol))))) | ||
| 443 | (when (and (facep symbol) value) | 388 | (when (and (facep symbol) value) |
| 444 | (if (bolp) | 389 | (princ (if (bolp) " '(" "\n '(")) |
| 445 | (princ " '(") | ||
| 446 | (princ "\n '(")) | ||
| 447 | (prin1 symbol) | 390 | (prin1 symbol) |
| 448 | (princ " ") | 391 | (princ " ") |
| 449 | (prin1 value) | 392 | (prin1 value) |
| 450 | (princ ")")))) | 393 | (princ ")")))) |
| 451 | (if (bolp) | 394 | (if (bolp) (princ " ")) |
| 452 | (princ " ")) | ||
| 453 | (princ ")") | 395 | (princ ")") |
| 454 | (unless (looking-at "\n") | 396 | (unless (looking-at "\n") |
| 455 | (princ "\n"))))) | 397 | (princ "\n"))))) |
| @@ -587,6 +529,19 @@ Theme files are named *-theme.el in `")) | |||
| 587 | :action (lambda (widget &rest ignore) | 529 | :action (lambda (widget &rest ignore) |
| 588 | (describe-variable 'load-path))) | 530 | (describe-variable 'load-path))) |
| 589 | (widget-insert "'.\n\n") | 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 | |||
| 590 | (widget-create 'push-button | 545 | (widget-create 'push-button |
| 591 | :tag " Save Theme Settings " | 546 | :tag " Save Theme Settings " |
| 592 | :help-echo "Save the selected themes for future sessions." | 547 | :help-echo "Save the selected themes for future sessions." |