mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-07 15:21:46 +00:00
Bugfixes for `customize-create-theme'.
* cus-theme.el (customize-create-theme): Delete overlays after erasing. If given a THEME arg, display only the faces of that arg instead of custom-theme--listed-faces. (custom-theme-variable-menu, custom-theme-variable-action) (custom-variable-reset-theme, custom-theme-delete-variable): Deleted. (custom-theme-add-variable, custom-theme-add-face): Apply value from the theme settings, instead of the current value. (custom-theme-add-var-1, custom-theme-add-face-1): New functions. (custom-theme-visit-theme): Allow calling outside theme buffers. (custom-theme-merge-theme): Don't enable the theme when merging. (custom-theme-write-variables, custom-theme-write-faces): Use the :shown-value properties to save buffer values, not global ones. (customize-themes): Display a warning about user customizations. * cus-edit.el (custom-variable-value-create) (custom-face-value-create): Obey new special properties :shown-value and :inhibit-magic.
This commit is contained in:
Chong Yidong
parent
e3fc5b1907
commit
da16abfc7e
@ -1,3 +1,23 @@
|
||||
2010-10-16 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* cus-theme.el (customize-create-theme): Delete overlays after
|
||||
erasing. If given a THEME arg, display only the faces of that arg
|
||||
instead of custom-theme--listed-faces.
|
||||
(custom-theme-variable-menu, custom-theme-variable-action)
|
||||
(custom-variable-reset-theme, custom-theme-delete-variable): Deleted.
|
||||
(custom-theme-add-variable, custom-theme-add-face): Apply value
|
||||
from the theme settings, instead of the current value.
|
||||
(custom-theme-add-var-1, custom-theme-add-face-1): New functions.
|
||||
(custom-theme-visit-theme): Allow calling outside theme buffers.
|
||||
(custom-theme-merge-theme): Don't enable the theme when merging.
|
||||
(custom-theme-write-variables, custom-theme-write-faces): Use the
|
||||
:shown-value properties to save buffer values, not global ones.
|
||||
(customize-themes): Display a warning about user customizations.
|
||||
|
||||
* cus-edit.el (custom-variable-value-create)
|
||||
(custom-face-value-create): Obey new special properties
|
||||
:shown-value and :inhibit-magic.
|
||||
|
||||
2010-10-15 Michael Albinus <michael.albinus@gmx.de>
|
||||
|
||||
* net/tramp-sh.el (tramp-open-connection-setup-interactive-shell):
|
||||
|
||||
@ -2460,7 +2460,13 @@ The following properties have special meanings for this widget:
|
||||
:custom-form should be a symbol describing how to display and
|
||||
edit the variable---either `edit' (using edit widgets),
|
||||
`lisp' (as a Lisp sexp), or `mismatch' (should not happen);
|
||||
if nil, use the return value of `custom-variable-default-form'."
|
||||
if nil, use the return value of `custom-variable-default-form'.
|
||||
|
||||
:shown-value, if non-nil, should be a list whose `car' is the
|
||||
variable value to display in place of the current value.
|
||||
|
||||
:inhibit-magic, if non-nil, inhibits creating the magic
|
||||
custom-state widget."
|
||||
:format "%v"
|
||||
:help-echo "Set or reset this variable."
|
||||
:documentation-property #'custom-variable-documentation
|
||||
@ -2512,9 +2518,12 @@ try matching its doc string against `custom-guess-doc-alist'."
|
||||
(get (or (get symbol 'custom-get) 'default-value))
|
||||
(prefix (widget-get widget :custom-prefix))
|
||||
(last (widget-get widget :custom-last))
|
||||
(value (if (default-boundp symbol)
|
||||
(funcall get symbol)
|
||||
(widget-get conv :value)))
|
||||
(value (let ((shown-value (widget-get widget :shown-value)))
|
||||
(cond (shown-value
|
||||
(car shown-value))
|
||||
((default-boundp symbol)
|
||||
(funcall get symbol))
|
||||
(t (widget-get conv :value)))))
|
||||
(state (or (widget-get widget :custom-state)
|
||||
(if (memq (custom-variable-state symbol value)
|
||||
(widget-get widget :hidden-states))
|
||||
@ -2622,10 +2631,11 @@ try matching its doc string against `custom-guess-doc-alist'."
|
||||
(unless (eq (preceding-char) ?\n)
|
||||
(widget-insert "\n"))
|
||||
;; Create the magic button.
|
||||
(let ((magic (widget-create-child-and-convert
|
||||
widget 'custom-magic nil)))
|
||||
(widget-put widget :custom-magic magic)
|
||||
(push magic buttons))
|
||||
(unless (widget-get widget :inhibit-magic)
|
||||
(let ((magic (widget-create-child-and-convert
|
||||
widget 'custom-magic nil)))
|
||||
(widget-put widget :custom-magic magic)
|
||||
(push magic buttons)))
|
||||
(widget-put widget :buttons buttons)
|
||||
;; Insert documentation.
|
||||
(widget-put widget :documentation-indent 3)
|
||||
@ -3281,12 +3291,17 @@ The following properties have special meanings for this widget:
|
||||
Lisp sexp), or `mismatch' (should not happen); if nil, use
|
||||
the return value of `custom-face-default-form'.
|
||||
|
||||
:display-style, if non-nil, should be a symbol describing the
|
||||
style of display to use. If the value is `concise', a more
|
||||
concise interface is shown.
|
||||
:display-style, if non-nil, describes the style of display to
|
||||
use. If the value is `concise', a neater interface is shown.
|
||||
|
||||
:sample-indent, if non-nil, should be an integer; this is the
|
||||
number of columns to which to indent the face sample."
|
||||
:sample-indent, if non-nil, is the number of columns to which to
|
||||
indent the face sample (an integer).
|
||||
|
||||
:shown-value, if non-nil, is the face spec to display as the value
|
||||
of the widget, instead of the current face spec.
|
||||
|
||||
:inhibit-magic, if non-nil, inhibits creating the magic
|
||||
custom-state widget."
|
||||
:sample-face 'custom-face-tag
|
||||
:help-echo "Set or reset this face."
|
||||
:documentation-property #'face-doc-string
|
||||
@ -3429,14 +3444,19 @@ WIDGET should be a `custom-face' widget."
|
||||
(indent-to-column sample-indent)))
|
||||
(push (widget-create-child-and-convert
|
||||
widget 'item
|
||||
:format "[%{%t%}]" :sample-face symbol :tag "sample")
|
||||
:format "[%{%t%}]"
|
||||
:sample-face (let ((spec (widget-get widget :shown-value)))
|
||||
(if spec (face-spec-choose spec) symbol))
|
||||
:tag "sample")
|
||||
buttons)
|
||||
;; Magic.
|
||||
(insert "\n")
|
||||
(let ((magic (widget-create-child-and-convert
|
||||
widget 'custom-magic nil)))
|
||||
(widget-put widget :custom-magic magic)
|
||||
(push magic buttons))
|
||||
|
||||
;; Magic.
|
||||
(unless (widget-get widget :inhibit-magic)
|
||||
(let ((magic (widget-create-child-and-convert
|
||||
widget 'custom-magic nil)))
|
||||
(widget-put widget :custom-magic magic)
|
||||
(push magic buttons)))
|
||||
|
||||
;; Update buttons.
|
||||
(widget-put widget :buttons buttons)
|
||||
@ -3465,7 +3485,8 @@ WIDGET should be a `custom-face' widget."
|
||||
(unless (widget-get widget :custom-form)
|
||||
(widget-put widget :custom-form custom-face-default-form))
|
||||
|
||||
(let* ((spec (custom-face-get-current-spec symbol))
|
||||
(let* ((spec (or (widget-get widget :shown-value)
|
||||
(custom-face-get-current-spec symbol)))
|
||||
(form (widget-get widget :custom-form))
|
||||
(indent (widget-get widget :indent))
|
||||
face-alist face-entry spec-default spec-match editor)
|
||||
|
||||
@ -79,12 +79,14 @@ Do not call this mode function yourself. It is meant for internal use."
|
||||
(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."
|
||||
BUFFER, if non-nil, should be a buffer to use; the default is
|
||||
named *Custom Theme*."
|
||||
(interactive)
|
||||
(switch-to-buffer (get-buffer-create (or buffer "*Custom Theme*")))
|
||||
;; Save current faces
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer))
|
||||
(erase-buffer)
|
||||
(dolist (ov (overlays-in (point-min) (point-max)))
|
||||
(delete-overlay ov)))
|
||||
(custom-new-theme-mode)
|
||||
(make-local-variable 'custom-theme-name)
|
||||
(set (make-local-variable 'custom-theme--save-name) theme)
|
||||
@ -121,50 +123,59 @@ BUFFER, if non-nil, should be a buffer to use."
|
||||
(widget-create 'push-button
|
||||
:notify (function custom-theme-write)
|
||||
" Save Theme ")
|
||||
;; Face widgets
|
||||
(widget-insert "\n\n Theme faces:\n")
|
||||
(let (widget)
|
||||
(dolist (face custom-theme--listed-faces)
|
||||
(widget-insert " ")
|
||||
(setq widget (widget-create 'custom-face
|
||||
:documentation-shown t
|
||||
:tag (custom-unlispify-tag-name face)
|
||||
:value face
|
||||
:display-style 'concise
|
||||
:custom-state 'hidden
|
||||
:sample-indent 34))
|
||||
(custom-magic-reset widget)
|
||||
(push (cons face widget) custom-theme-faces)))
|
||||
(insert " ")
|
||||
(setq custom-theme-insert-face-marker (point-marker))
|
||||
(insert " ")
|
||||
(widget-create 'push-button
|
||||
:tag "Insert Additional Face"
|
||||
:help-echo "Add another face to this theme."
|
||||
:follow-link 'mouse-face
|
||||
:button-face 'custom-link
|
||||
:mouse-face 'highlight
|
||||
:pressed-face 'highlight
|
||||
:action (lambda (widget &optional event)
|
||||
(call-interactively 'custom-theme-add-face)))
|
||||
(widget-insert "\n\n Theme variables:\n ")
|
||||
(setq custom-theme-insert-variable-marker (point-marker))
|
||||
(widget-insert ?\s)
|
||||
(widget-create 'push-button
|
||||
:tag "Insert Variable"
|
||||
:help-echo "Add another variable to this theme."
|
||||
:follow-link 'mouse-face
|
||||
:button-face 'custom-link
|
||||
:mouse-face 'highlight
|
||||
:pressed-face 'highlight
|
||||
: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 ""))
|
||||
|
||||
(let (vars values faces face-specs)
|
||||
|
||||
;; Load the theme settings.
|
||||
(when theme
|
||||
(load-theme theme t)
|
||||
(dolist (setting (get theme 'theme-settings))
|
||||
(if (eq (car setting) 'theme-value)
|
||||
(progn (push (nth 1 setting) vars)
|
||||
(push (nth 3 setting) values))
|
||||
(push (nth 1 setting) faces)
|
||||
(push (nth 3 setting) face-specs))))
|
||||
|
||||
;; If THEME is non-nil, insert all of that theme's faces.
|
||||
;; Otherwise, insert those in `custom-theme--listed-faces'.
|
||||
(widget-insert "\n\n Theme faces:\n ")
|
||||
(if theme
|
||||
(while faces
|
||||
(custom-theme-add-face-1 (pop faces) (pop face-specs)))
|
||||
(dolist (face custom-theme--listed-faces)
|
||||
(custom-theme-add-face-1 face nil)))
|
||||
(setq custom-theme-insert-face-marker (point-marker))
|
||||
(widget-insert " ")
|
||||
(widget-create 'push-button
|
||||
:tag "Insert Additional Face"
|
||||
:help-echo "Add another face to this theme."
|
||||
:follow-link 'mouse-face
|
||||
:button-face 'custom-link
|
||||
:mouse-face 'highlight
|
||||
:pressed-face 'highlight
|
||||
:action (lambda (widget &optional event)
|
||||
(call-interactively 'custom-theme-add-face)))
|
||||
|
||||
;; If THEME is non-nil, insert all of that theme's variables.
|
||||
(widget-insert "\n\n Theme variables:\n ")
|
||||
(if theme
|
||||
(while vars
|
||||
(custom-theme-add-var-1 (pop vars) (pop values))))
|
||||
(setq custom-theme-insert-variable-marker (point-marker))
|
||||
(widget-insert " ")
|
||||
(widget-create 'push-button
|
||||
:tag "Insert Variable"
|
||||
:help-echo "Add another variable to this theme."
|
||||
:follow-link 'mouse-face
|
||||
:button-face 'custom-link
|
||||
:mouse-face 'highlight
|
||||
:pressed-face 'highlight
|
||||
:action (lambda (widget &optional event)
|
||||
(call-interactively 'custom-theme-add-variable)))
|
||||
(widget-insert ?\n)
|
||||
(widget-setup)
|
||||
(goto-char (point-min))
|
||||
(message "")))
|
||||
|
||||
(defun custom-theme-revert (ignore-auto noconfirm)
|
||||
(when (or noconfirm (y-or-n-p "Discard current changes? "))
|
||||
@ -172,177 +183,119 @@ BUFFER, if non-nil, should be a buffer to use."
|
||||
|
||||
;;; Theme variables
|
||||
|
||||
(defun custom-theme-add-variable (symbol)
|
||||
(interactive "vVariable name: ")
|
||||
(cond ((assq symbol custom-theme-variables)
|
||||
(message "%s is already in the theme" (symbol-name symbol)))
|
||||
((not (boundp symbol))
|
||||
(message "%s is not defined as a variable" (symbol-name symbol)))
|
||||
((eq symbol 'custom-enabled-themes)
|
||||
(message "Custom theme cannot contain `custom-enabled-themes'"))
|
||||
(t
|
||||
(save-excursion
|
||||
(goto-char custom-theme-insert-variable-marker)
|
||||
(widget-insert " ")
|
||||
(let ((widget (widget-create 'custom-variable
|
||||
:tag (custom-unlispify-tag-name symbol)
|
||||
:custom-level 0
|
||||
:action 'custom-theme-variable-action
|
||||
:custom-state 'unknown
|
||||
:value symbol)))
|
||||
(push (cons symbol widget) custom-theme-variables)
|
||||
(custom-magic-reset widget))
|
||||
(widget-insert " ")
|
||||
(move-marker custom-theme-insert-variable-marker (point))
|
||||
(widget-setup)))))
|
||||
(defun custom-theme-add-variable (var value)
|
||||
"Add a widget for VAR (a symbol) to the *New Custom Theme* buffer.
|
||||
VALUE should be a value to which to set the widget; when called
|
||||
interactively, this defaults to the current value of VAR."
|
||||
(interactive
|
||||
(let ((v (read-variable "Variable name: ")))
|
||||
(list v (symbol-value v))))
|
||||
(let ((var-and-widget (assq var custom-theme-faces)))
|
||||
(cond ((null var-and-widget)
|
||||
;; If VAR is not yet in the buffer, add it.
|
||||
(save-excursion
|
||||
(goto-char custom-theme-insert-variable-marker)
|
||||
(custom-theme-add-var-1 var value)
|
||||
(move-marker custom-theme-insert-variable-marker (point))
|
||||
(widget-setup)))
|
||||
;; Otherwise, alter that var widget.
|
||||
(t
|
||||
(let ((widget (cdr var-and-widget)))
|
||||
(widget-put widget :shown-value (list value))
|
||||
(custom-redraw widget))))))
|
||||
|
||||
(defvar custom-theme-variable-menu
|
||||
`(("Reset to Current" custom-redraw
|
||||
(lambda (widget)
|
||||
(and (boundp (widget-value widget))
|
||||
(memq (widget-get widget :custom-state)
|
||||
'(themed modified changed)))))
|
||||
("Reset to Theme Value" custom-variable-reset-theme
|
||||
(lambda (widget)
|
||||
(let ((theme (intern (widget-value custom-theme-name)))
|
||||
(symbol (widget-value widget))
|
||||
found)
|
||||
(and (custom-theme-p theme)
|
||||
(dolist (setting (get theme 'theme-settings) found)
|
||||
(if (and (eq (cadr setting) symbol)
|
||||
(eq (car setting) 'theme-value))
|
||||
(setq found t)))))))
|
||||
("---" ignore ignore)
|
||||
("Delete" custom-theme-delete-variable nil))
|
||||
"Alist of actions for the `custom-variable' widget in Custom Theme Mode.
|
||||
See the documentation for `custom-variable'.")
|
||||
|
||||
(defun custom-theme-variable-action (widget &optional event)
|
||||
"Show the Custom Theme Mode menu for a `custom-variable' widget.
|
||||
Optional EVENT is the location for the menu."
|
||||
(let ((custom-variable-menu custom-theme-variable-menu))
|
||||
(custom-variable-action widget event)))
|
||||
|
||||
(defun custom-variable-reset-theme (widget)
|
||||
"Reset WIDGET to its value for the currently edited theme."
|
||||
(let ((theme (intern (widget-value custom-theme-name)))
|
||||
(symbol (widget-value widget))
|
||||
found)
|
||||
(dolist (setting (get theme 'theme-settings))
|
||||
(if (and (eq (cadr setting) symbol)
|
||||
(eq (car setting) 'theme-value))
|
||||
(setq found setting)))
|
||||
(widget-value-set (car (widget-get widget :children))
|
||||
(nth 3 found)))
|
||||
(widget-put widget :custom-state 'themed)
|
||||
(custom-redraw-magic widget)
|
||||
(widget-setup))
|
||||
|
||||
(defun custom-theme-delete-variable (widget)
|
||||
(setq custom-theme-variables
|
||||
(assq-delete-all (widget-value widget) custom-theme-variables))
|
||||
(widget-delete widget))
|
||||
(defun custom-theme-add-var-1 (symbol val)
|
||||
(widget-insert " ")
|
||||
(push (cons symbol
|
||||
(widget-create 'custom-variable
|
||||
:tag (custom-unlispify-tag-name symbol)
|
||||
:value symbol
|
||||
:shown-value (list val)
|
||||
:notify 'ignore
|
||||
:custom-level 0
|
||||
:custom-state 'hidden
|
||||
:inhibit-magic t))
|
||||
custom-theme-variables)
|
||||
(widget-insert " "))
|
||||
|
||||
;;; Theme faces
|
||||
|
||||
(defun custom-theme-add-face (symbol)
|
||||
(interactive (list (read-face-name "Face name" nil nil)))
|
||||
(cond ((assq symbol custom-theme-faces)
|
||||
(message "%s is already in the theme" (symbol-name symbol)))
|
||||
((not (facep symbol))
|
||||
(message "%s is not defined as a face" (symbol-name symbol)))
|
||||
(t
|
||||
(save-excursion
|
||||
(goto-char custom-theme-insert-face-marker)
|
||||
(widget-insert " ")
|
||||
(let ((widget (widget-create 'custom-face
|
||||
:tag (custom-unlispify-tag-name symbol)
|
||||
:custom-level 0
|
||||
:action 'custom-theme-face-action
|
||||
:custom-state 'unknown
|
||||
:display-style 'concise
|
||||
:sample-indent 34
|
||||
:value symbol)))
|
||||
(push (cons symbol widget) custom-theme-faces)
|
||||
(custom-magic-reset widget)
|
||||
(widget-insert " ")
|
||||
(defun custom-theme-add-face (face &optional spec)
|
||||
"Add a widget for FACE (a symbol) to the *New Custom Theme* buffer.
|
||||
SPEC, if non-nil, should be a face spec to which to set the widget."
|
||||
(interactive (list (read-face-name "Face name" nil nil) nil))
|
||||
(unless (or (facep face) spec)
|
||||
(error "`%s' has no face definition" face))
|
||||
(let ((face-and-widget (assq face custom-theme-faces)))
|
||||
(cond ((null face-and-widget)
|
||||
;; If FACE is not yet in the buffer, add it.
|
||||
(save-excursion
|
||||
(goto-char custom-theme-insert-face-marker)
|
||||
(custom-theme-add-face-1 face spec)
|
||||
(move-marker custom-theme-insert-face-marker (point))
|
||||
(widget-setup))))))
|
||||
(widget-setup)))
|
||||
;; Otherwise, if SPEC is supplied, alter that face widget.
|
||||
(spec
|
||||
(let ((widget (cdr face-and-widget)))
|
||||
(widget-put widget :shown-value spec)
|
||||
(custom-redraw widget)))
|
||||
((called-interactively-p 'interactive)
|
||||
(error "`%s' is already present" face)))))
|
||||
|
||||
(defvar custom-theme-face-menu
|
||||
`(("Reset to Theme Value" custom-face-reset-theme
|
||||
(lambda (widget)
|
||||
(let ((theme (intern (widget-value custom-theme-name)))
|
||||
(symbol (widget-value widget))
|
||||
found)
|
||||
(and (custom-theme-p theme)
|
||||
(dolist (setting (get theme 'theme-settings) found)
|
||||
(if (and (eq (cadr setting) symbol)
|
||||
(eq (car setting) 'theme-face))
|
||||
(setq found t)))))))
|
||||
("---" ignore ignore)
|
||||
("Delete" custom-theme-delete-face nil))
|
||||
"Alist of actions for the `custom-variable' widget in Custom Theme Mode.
|
||||
See the documentation for `custom-variable'.")
|
||||
|
||||
(defun custom-theme-face-action (widget &optional event)
|
||||
"Show the Custom Theme Mode menu for a `custom-face' widget.
|
||||
Optional EVENT is the location for the menu."
|
||||
(let ((custom-face-menu custom-theme-face-menu))
|
||||
(custom-face-action widget event)))
|
||||
|
||||
(defun custom-face-reset-theme (widget)
|
||||
"Reset WIDGET to its value for the currently edited theme."
|
||||
(let ((theme (intern (widget-value custom-theme-name)))
|
||||
(symbol (widget-value widget))
|
||||
found)
|
||||
(dolist (setting (get theme 'theme-settings))
|
||||
(if (and (eq (cadr setting) symbol)
|
||||
(eq (car setting) 'theme-face))
|
||||
(setq found setting)))
|
||||
(widget-value-set (car (widget-get widget :children))
|
||||
(nth 3 found)))
|
||||
(widget-put widget :custom-state 'themed)
|
||||
(custom-redraw-magic widget)
|
||||
(widget-setup))
|
||||
|
||||
(defun custom-theme-delete-face (widget)
|
||||
(setq custom-theme-faces
|
||||
(assq-delete-all (widget-value widget) custom-theme-faces))
|
||||
(widget-delete widget))
|
||||
(defun custom-theme-add-face-1 (symbol spec)
|
||||
(widget-insert " ")
|
||||
(push (cons symbol
|
||||
(widget-create 'custom-face
|
||||
:tag (custom-unlispify-tag-name symbol)
|
||||
:documentation-shown t
|
||||
:value symbol
|
||||
:custom-state 'hidden
|
||||
:display-style 'concise
|
||||
:shown-value spec
|
||||
:inhibit-magic t
|
||||
:sample-indent 34))
|
||||
custom-theme-faces)
|
||||
(widget-insert " "))
|
||||
|
||||
;;; Reading and writing
|
||||
|
||||
(defun custom-theme-visit-theme ()
|
||||
(interactive)
|
||||
(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)))
|
||||
(widget-value-set custom-theme-description
|
||||
(or (get theme 'theme-documentation)
|
||||
(format-time-string "Created %Y-%m-%d.")))
|
||||
(widget-setup))))
|
||||
(defun custom-theme-visit-theme (theme)
|
||||
"Load the custom theme THEME's settings into the current buffer."
|
||||
(interactive
|
||||
(list
|
||||
(intern (completing-read "Find custom theme: "
|
||||
(mapcar 'symbol-name
|
||||
(custom-available-themes))))))
|
||||
(unless (custom-theme-name-valid-p theme)
|
||||
(error "No valid theme named `%s'" theme))
|
||||
(cond ((not (eq major-mode 'custom-new-theme-mode))
|
||||
(customize-create-theme theme))
|
||||
((y-or-n-p "Discard current changes? ")
|
||||
(setq custom-theme--save-name theme)
|
||||
(custom-theme-revert nil t))))
|
||||
|
||||
(defun custom-theme-merge-theme (theme)
|
||||
"Merge the custom theme THEME's settings into the current buffer."
|
||||
(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)))
|
||||
(unless (eq theme 'user)
|
||||
(unless (custom-theme-name-valid-p theme)
|
||||
(error "Invalid theme name `%s'" theme))
|
||||
(load-theme theme t))
|
||||
(let ((settings (reverse (get theme 'theme-settings))))
|
||||
(dolist (setting settings)
|
||||
(if (eq (car setting) 'theme-value)
|
||||
(custom-theme-add-variable (cadr setting))
|
||||
(custom-theme-add-face (cadr setting)))))
|
||||
(disable-theme theme)
|
||||
(funcall (if (eq (car setting) 'theme-value)
|
||||
'custom-theme-add-variable
|
||||
'custom-theme-add-face)
|
||||
(nth 1 setting)
|
||||
(nth 3 setting))))
|
||||
theme)
|
||||
|
||||
(defun custom-theme-write (&rest ignore)
|
||||
"Write the current custom theme to its theme file."
|
||||
(interactive)
|
||||
(let* ((name (widget-value custom-theme-name))
|
||||
(doc (widget-value custom-theme-description))
|
||||
@ -395,11 +348,12 @@ It includes all variables in list VARS."
|
||||
(princ "\n")
|
||||
(dolist (spec vars)
|
||||
(let* ((symbol (car spec))
|
||||
(child (car-safe (widget-get (cdr spec) :children)))
|
||||
(widget (cdr spec))
|
||||
(child (car-safe (widget-get widget :children)))
|
||||
(value (if child
|
||||
(widget-value child)
|
||||
;; For hidden widgets, use the standard value
|
||||
(get symbol 'standard-value))))
|
||||
;; Child is null if the widget is closed (hidden).
|
||||
(car (widget-get widget :shown-value)))))
|
||||
(when (boundp symbol)
|
||||
(unless (bolp)
|
||||
(princ "\n"))
|
||||
@ -426,30 +380,18 @@ It includes all faces in list FACES."
|
||||
(dolist (spec faces)
|
||||
(let* ((symbol (car spec))
|
||||
(widget (cdr spec))
|
||||
(child (car-safe (widget-get widget :children)))
|
||||
(state (if child
|
||||
(widget-get widget :custom-state)
|
||||
(custom-face-state symbol)))
|
||||
(value
|
||||
(cond ((eq state 'standard)
|
||||
nil) ; do nothing
|
||||
(child
|
||||
(custom-face-widget-to-spec widget))
|
||||
(t
|
||||
;; Widget is closed (hidden), but the face has
|
||||
;; a non-standard value. Try to extract that
|
||||
;; value and save it.
|
||||
(custom-face-get-current-spec symbol)))))
|
||||
(if (car-safe (widget-get widget :children))
|
||||
(custom-face-widget-to-spec widget)
|
||||
;; Child is null if the widget is closed (hidden).
|
||||
(widget-get widget :shown-value))))
|
||||
(when (and (facep symbol) value)
|
||||
(if (bolp)
|
||||
(princ " '(")
|
||||
(princ "\n '("))
|
||||
(princ (if (bolp) " '(" "\n '("))
|
||||
(prin1 symbol)
|
||||
(princ " ")
|
||||
(prin1 value)
|
||||
(princ ")"))))
|
||||
(if (bolp)
|
||||
(princ " "))
|
||||
(if (bolp) (princ " "))
|
||||
(princ ")")
|
||||
(unless (looking-at "\n")
|
||||
(princ "\n")))))
|
||||
@ -587,6 +529,19 @@ Theme files are named *-theme.el in `"))
|
||||
:action (lambda (widget &rest ignore)
|
||||
(describe-variable 'load-path)))
|
||||
(widget-insert "'.\n\n")
|
||||
|
||||
;; If the user has made customizations, display a warning and
|
||||
;; provide buttons to disable or convert them.
|
||||
(let ((user-settings (get 'user 'theme-settings)))
|
||||
(unless (or (null user-settings)
|
||||
(and (null (cdr user-settings))
|
||||
(eq (caar user-settings) 'theme-value)
|
||||
(eq (cadr (car user-settings)) 'custom-enabled-themes)))
|
||||
(widget-insert "Note: Your custom settings take precedence over theme settings.\n\n")
|
||||
;; FIXME: Provide some way to painlessly disable or migrate
|
||||
;; these settings.
|
||||
))
|
||||
|
||||
(widget-create 'push-button
|
||||
:tag " Save Theme Settings "
|
||||
:help-echo "Save the selected themes for future sessions."
|
||||
|
||||
Loading…
Reference in New Issue
Block a user