# HG changeset patch # User Chong Yidong # Date 1287188194 14400 # Node ID 5ffdb52c377cb3fa6239391c2a639948bf55b505 # Parent 2b6e7f13777356ee2a931eeb0e8dfb9f1a1985af 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. diff -r 2b6e7f137773 -r 5ffdb52c377c lisp/ChangeLog --- a/lisp/ChangeLog Fri Oct 15 20:45:12 2010 +0200 +++ b/lisp/ChangeLog Fri Oct 15 20:16:34 2010 -0400 @@ -1,3 +1,23 @@ +2010-10-16 Chong Yidong + + * 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 * net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): diff -r 2b6e7f137773 -r 5ffdb52c377c lisp/cus-edit.el --- a/lisp/cus-edit.el Fri Oct 15 20:45:12 2010 +0200 +++ b/lisp/cus-edit.el Fri Oct 15 20:16:34 2010 -0400 @@ -2460,7 +2460,13 @@ :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 @@ (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 @@ (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 @@ 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. - -:sample-indent, if non-nil, should be an integer; this is the -number of columns to which to indent the face sample." +: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, 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 @@ (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 @@ (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) diff -r 2b6e7f137773 -r 5ffdb52c377c lisp/cus-theme.el --- a/lisp/cus-theme.el Fri Oct 15 20:45:12 2010 +0200 +++ b/lisp/cus-theme.el Fri Oct 15 20:16:34 2010 -0400 @@ -79,12 +79,14 @@ (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 @@ (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 @@ ;;; 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 @@ (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 @@ (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 @@ :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."