X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fcus-edit.el;h=38b437fa67eff858b3ea74e91bf9244f7318648d;hb=21db8709c0c2dcedbd278c7fe571290d5ce80a71;hp=30b0c86d52b7986ab3bc2c23bff06d3929dd11f6;hpb=716cfba952c1dc0d2cf5c968971f3780ba728a89;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 30b0c86..38b437f 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -55,6 +55,7 @@ (require 'cus-load) (require 'cus-start) +(require 'cus-file) ;; Huh? This looks dirty! (put 'custom-define-hook 'custom-type 'hook) @@ -303,7 +304,8 @@ Return a list suitable for use in `interactive'." obarray (lambda (symbol) (and (boundp symbol) (or (get symbol 'custom-type) - (user-variable-p symbol)))) t)) + (user-variable-p symbol)))) + t nil nil (and v (symbol-name v)))) (list (if (equal val "") (if (symbolp v) v nil) (intern val))))) @@ -560,14 +562,24 @@ groups after non-groups, if nil do not order groups at all." children))) (defun Custom-save () - "Set all modified group members and save them." + "Set all modified options and save them." (interactive) - (let ((children custom-options)) + (let ((all-children custom-options) + children) (mapc (lambda (child) (when (memq (widget-get child :custom-state) '(modified set)) - (widget-apply child :custom-save))) - children)) - (custom-save-all)) + (push child children))) + all-children) + (let ((the-children children) + child) + (while (setq child (pop the-children)) + (widget-apply child :custom-pre-save))) + (custom-save-all) + (let ((the-children children) + child) + (while (setq child (pop the-children)) + (widget-apply child :custom-post-save))) + )) (defvar custom-reset-menu '(("Current" . Custom-reset-current) @@ -608,11 +620,23 @@ when the action is chosen.") (defun Custom-reset-standard (&rest ignore) "Reset all modified, set, or saved group members to their standard settings." (interactive) - (let ((children custom-options)) + (let ((all-children custom-options) + children must-save) (mapc (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-reset-standard))) - children))) + (when (memq (widget-get child :custom-state) '(modified set saved)) + (push child children))) + all-children) + (let ((the-children children) + child) + (while (setq child (pop the-children)) + (and (widget-apply child :custom-pre-reset-standard) + (setq must-save t)))) + (and must-save (custom-save-all)) + (let ((the-children children) + child) + (while (setq child (pop the-children)) + (widget-apply child :custom-post-reset-standard))) + )) ;;; The Customize Commands @@ -681,8 +705,8 @@ If given a prefix (or a COMMENT argument), also prompt for a comment." (put var 'variable-comment comment)))) ;;;###autoload -(defun customize-set-variable (var val &optional comment) - "Set the default for VARIABLE to VALUE. VALUE is a Lisp object. +(defun customize-set-variable (variable value &optional comment) + "Set the default for VARIABLE to VALUE. VALUE is any Lisp object. If VARIABLE has a `custom-set' property, that is used for setting VARIABLE, otherwise `set-default' is used. @@ -700,18 +724,18 @@ If given a prefix (or a COMMENT argument), also prompt for a comment." (interactive (custom-prompt-variable "Set variable: " "Set customized value for %s to: " current-prefix-arg)) - (funcall (or (get var 'custom-set) 'set-default) var val) - (put var 'customized-value (list (custom-quote val))) + (funcall (or (get variable 'custom-set) 'set-default) variable value) + (put variable 'customized-value (list (custom-quote value))) (cond ((string= comment "") - (put var 'variable-comment nil) - (put var 'customized-variable-comment nil)) + (put variable 'variable-comment nil) + (put variable 'customized-variable-comment nil)) (comment - (put var 'variable-comment comment) - (put var 'customized-variable-comment comment)))) + (put variable 'variable-comment comment) + (put variable 'customized-variable-comment comment)))) ;;;###autoload -(defun customize-save-variable (var val &optional comment) +(defun customize-save-variable (variable value &optional comment) "Set the default for VARIABLE to VALUE, and save it for future sessions. If VARIABLE has a `custom-set' property, that is used for setting VARIABLE, otherwise `set-default' is used. @@ -729,15 +753,15 @@ If given a prefix (or a COMMENT argument), also prompt for a comment." (interactive (custom-prompt-variable "Set and ave variable: " "Set and save value for %s as: " current-prefix-arg)) - (funcall (or (get var 'custom-set) 'set-default) var val) - (put var 'saved-value (list (custom-quote val))) - (custom-push-theme 'theme-value var 'user 'set (list (custom-quote val))) + (funcall (or (get variable 'custom-set) 'set-default) variable value) + (put variable 'saved-value (list (custom-quote value))) + (custom-push-theme 'theme-value variable 'user 'set (list (custom-quote value))) (cond ((string= comment "") - (put var 'variable-comment nil) - (put var 'saved-variable-comment nil)) + (put variable 'variable-comment nil) + (put variable 'saved-variable-comment nil)) (comment - (put var 'variable-comment comment) - (put var 'saved-variable-comment comment))) + (put variable 'variable-comment comment) + (put variable 'saved-variable-comment comment))) (custom-save-all)) ;;;###autoload @@ -1846,10 +1870,14 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." :value-create 'custom-variable-value-create :action 'custom-variable-action :custom-set 'custom-variable-set + :custom-pre-save 'custom-variable-pre-save :custom-save 'custom-variable-save + :custom-post-save 'custom-variable-post-save :custom-reset-current 'custom-redraw :custom-reset-saved 'custom-variable-reset-saved - :custom-reset-standard 'custom-variable-reset-standard) + :custom-pre-reset-standard 'custom-variable-pre-reset-standard + :custom-reset-standard 'custom-variable-reset-standard + :custom-post-reset-standard 'custom-variable-post-reset-standard) (defun custom-variable-type (symbol) "Return a widget suitable for editing the value of SYMBOL. @@ -1987,7 +2015,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'." ;; Insert documentation. ;; #### NOTE: this is ugly!!!! I need to do update the :buttons property ;; before the call to `widget-default-format-handler'. Otherwise, I - ;; loose my current `buttons'. This function shouldn't be called like + ;; lose my current `buttons'. This function shouldn't be called like ;; this anyway. The doc string widget should be added like the others. ;; --dv (widget-put widget :buttons buttons) @@ -2173,8 +2201,8 @@ Optional EVENT is the location for the menu." (custom-variable-state-set widget) (custom-redraw-magic widget))) -(defun custom-variable-save (widget) - "Set and save the value for the variable being edited by WIDGET." +(defun custom-variable-pre-save (widget) + "Prepare for saving the value for the variable being edited by WIDGET." (let* ((form (widget-get widget :custom-form)) (state (widget-get widget :custom-state)) (child (car (widget-get widget :children))) @@ -2217,15 +2245,23 @@ Optional EVENT is the location for the menu." (put symbol 'saved-variable-comment comment))) (put symbol 'customized-value nil) (put symbol 'customized-variable-comment nil) - (custom-save-all) - (custom-variable-state-set widget) - (custom-redraw-magic widget))) + )) + +(defun custom-variable-post-save (widget) + "Finish saving the variable being edited by WIDGET." + (custom-variable-state-set widget) + (custom-redraw-magic widget)) + +(defun custom-variable-save (widget) + "Set and save the value for the variable being edited by WIDGET." + (custom-variable-pre-save widget) + (custom-save-all) + (custom-variable-post-save widget)) (defun custom-variable-reset-saved (widget) "Restore the saved value for the variable being edited by WIDGET." (let* ((symbol (widget-value widget)) (set (or (get symbol 'custom-set) 'set-default)) - (comment-widget (widget-get widget :comment-widget)) (value (get symbol 'saved-value)) (comment (get symbol 'saved-variable-comment))) (cond ((or value comment) @@ -2241,11 +2277,12 @@ Optional EVENT is the location for the menu." ;; This call will possibly make the comment invisible (custom-redraw widget))) -(defun custom-variable-reset-standard (widget) - "Restore the standard setting for the variable being edited by WIDGET." +;; This function returns non nil if we need to re-save the options --dv. +(defun custom-variable-pre-reset-standard (widget) + "Prepare for restoring the variable being edited by WIDGET to its +standard setting." (let* ((symbol (widget-value widget)) - (set (or (get symbol 'custom-set) 'set-default)) - (comment-widget (widget-get widget :comment-widget))) + (set (or (get symbol 'custom-set) 'set-default))) (if (get symbol 'standard-value) (funcall set symbol (eval (car (get symbol 'standard-value)))) (signal 'error (list "No standard setting known for variable" symbol))) @@ -2260,10 +2297,21 @@ Optional EVENT is the location for the menu." (if (null (cdr (get symbol 'theme-value))) (put symbol 'theme-value nil)) (put symbol 'saved-variable-comment nil) - (custom-save-all)) - (widget-put widget :custom-state 'unknown) - ;; This call will possibly make the comment invisible - (custom-redraw widget))) + widget) + )) + +(defun custom-variable-post-reset-standard (widget) + "Finish resetting the variable being edited by WIDGET to its standard +value." + (widget-put widget :custom-state 'unknown) + ;; This call will possibly make the comment invisible + (custom-redraw widget)) + +(defun custom-variable-reset-standard (widget) + "Restore the standard setting for the variable being edited by WIDGET." + (when (custom-variable-pre-reset-standard widget) + (custom-save-all)) + (custom-variable-post-reset-standard widget)) ;;; The `custom-face-edit' Widget. @@ -2302,6 +2350,10 @@ Only match the specified window systems") :sibling-args (:help-echo "\ The X11 Window System") x) + (const :format "GTK " + :sibling-args (:help-echo "\ +The GTK Window System") + gtk) (const :format "PM " :sibling-args (:help-echo "\ OS/2 Presentation Manager") @@ -2390,10 +2442,14 @@ Match frames with dark backgrounds") :custom-category 'face :custom-form nil ; defaults to value of `custom-face-default-form' :custom-set 'custom-face-set + :custom-pre-save 'custom-face-pre-save :custom-save 'custom-face-save + :custom-post-save 'custom-face-post-save :custom-reset-current 'custom-redraw :custom-reset-saved 'custom-face-reset-saved + :custom-pre-reset-standard 'custom-face-pre-reset-standard :custom-reset-standard 'custom-face-reset-standard + :custom-post-reset-standard 'custom-face-post-reset-standard :custom-menu 'custom-face-menu-create) (define-widget 'custom-face-all 'editable-list @@ -2636,8 +2692,8 @@ Optional EVENT is the location for the menu." (custom-face-state-set widget) (custom-redraw-magic widget))) -(defun custom-face-save (widget) - "Make the face attributes in WIDGET default." +(defun custom-face-pre-save (widget) + "Prepare for saving the face being edited by WIDGET." (let* ((symbol (widget-value widget)) (child (car (widget-get widget :children))) (value (widget-value child)) @@ -2655,12 +2711,21 @@ Optional EVENT is the location for the menu." (put symbol 'face-comment comment) (put symbol 'customized-face-comment nil) (put symbol 'saved-face-comment comment) - (custom-save-all) - (custom-face-state-set widget) - (custom-redraw-magic widget))) + )) + +(defun custom-face-post-save (widget) + "Finish saving the face being edited by WIDGET." + (custom-face-state-set widget) + (custom-redraw-magic widget)) + +(defun custom-face-save (widget) + "Save the face being edited by WIDGET." + (custom-face-pre-save widget) + (custom-save-all) + (custom-face-post-save widget)) (defun custom-face-reset-saved (widget) - "Restore WIDGET to the face's default attributes." + "Reset the face being edited by WIDGET to its saved value." (let* ((symbol (widget-value widget)) (child (car (widget-get widget :children))) (value (get symbol 'saved-face)) @@ -2678,12 +2743,12 @@ Optional EVENT is the location for the menu." (custom-face-state-set widget) (custom-redraw-magic widget))) -(defun custom-face-reset-standard (widget) - "Restore WIDGET to the face's standard settings." +;; This function returns non nil if we need to re-save the options --dv. +(defun custom-face-pre-reset-standard (widget) + "Prepare for restoring the face edited by WIDGET to its standard +settings." (let* ((symbol (widget-value widget)) - (child (car (widget-get widget :children))) - (value (get symbol 'face-defface-spec)) - (comment-widget (widget-get widget :comment-widget))) + (value (get symbol 'face-defface-spec))) (unless value (signal 'error (list "No standard setting for this face" symbol))) (put symbol 'customized-face nil) @@ -2695,14 +2760,30 @@ Optional EVENT is the location for the menu." (if (null (cdr (get symbol 'theme-face))) (put symbol 'theme-face nil)) (put symbol 'saved-face-comment nil) - (custom-save-all)) + widget) + )) + +(defun custom-face-post-reset-standard (widget) + "Finish restoring the face edited by WIDGET to its standard settings." + (let* ((symbol (widget-value widget)) + (child (car (widget-get widget :children))) + (value (get symbol 'face-defface-spec)) + (comment-widget (widget-get widget :comment-widget))) (face-spec-set symbol value nil '(custom)) (put symbol 'face-comment nil) (widget-value-set child value) ;; This call manages the comment visibility (widget-value-set comment-widget "") (custom-face-state-set widget) - (custom-redraw-magic widget))) + (custom-redraw-magic widget) + )) + +(defun custom-face-reset-standard (widget) + "Restore the face edited by WIDGET to its standard settings." + (when (custom-face-pre-reset-standard widget) + (custom-save-all)) + (custom-face-post-reset-standard widget)) + ;;; The `face' Widget. @@ -2875,10 +2956,14 @@ and so forth. The remaining group tags are shown with :action 'custom-group-action :custom-category 'group :custom-set 'custom-group-set + :custom-pre-save 'custom-group-pre-save :custom-save 'custom-group-save + :custom-post-save 'custom-group-post-save :custom-reset-current 'custom-group-reset-current :custom-reset-saved 'custom-group-reset-saved + :custom-pre-reset-standard 'custom-group-pre-reset-standard :custom-reset-standard 'custom-group-reset-standard + :custom-post-reset-standard 'custom-group-post-reset-standard :custom-menu 'custom-group-menu-create) (defun custom-group-sample-face-get (widget) @@ -3187,14 +3272,28 @@ Optional EVENT is the location for the menu." (widget-apply child :custom-set))) children))) -(defun custom-group-save (widget) +(defun custom-group-pre-save (widget) + "Prepare for saving all modified group members." + (let ((children (widget-get widget :children))) + (mapc (lambda (child) + (when (memq (widget-get child :custom-state) '(modified set)) + (widget-apply child :custom-pre-save))) + children))) + +(defun custom-group-post-save (widget) "Save all modified group members." (let ((children (widget-get widget :children))) (mapc (lambda (child) (when (memq (widget-get child :custom-state) '(modified set)) - (widget-apply child :custom-save))) + (widget-apply child :custom-post-save))) children))) +(defun custom-group-save (widget) + "Save all modified group members." + (custom-group-pre-save widget) + (custom-save-all) + (custom-group-post-save widget)) + (defun custom-group-reset-current (widget) "Reset all modified group members." (let ((children (widget-get widget :children))) @@ -3211,15 +3310,35 @@ Optional EVENT is the location for the menu." (widget-apply child :custom-reset-saved))) children))) -(defun custom-group-reset-standard (widget) - "Reset all modified, set, or saved group members." +;; This function returns non nil when we need to re-save the options --dv. +(defun custom-group-pre-reset-standard (widget) + "Prepare for resetting all modified, set, or saved group members." + (let ((children (widget-get widget :children)) + must-save) + (mapc (lambda (child) + (when (memq (widget-get child :custom-state) + '(modified set saved)) + (and (widget-apply child :custom-pre-reset-standard) + (setq must-save t)))) + children) + must-save + )) + +(defun custom-group-post-reset-standard (widget) + "Finish resetting all modified, set, or saved group members." (let ((children (widget-get widget :children))) (mapc (lambda (child) (when (memq (widget-get child :custom-state) '(modified set saved)) - (widget-apply child :custom-reset-standard))) + (widget-apply child :custom-post-reset-standard))) children))) +(defun custom-group-reset-standard (widget) + "Reset all modified, set, or saved group members." + (when (custom-group-pre-reset-standard widget) + (custom-save-all)) + (custom-group-post-reset-standard widget)) + (defun custom-group-state-update (widget) "Update magic." (unless (eq (widget-get widget :custom-state) 'hidden) @@ -3239,15 +3358,6 @@ Optional EVENT is the location for the menu." (widget-put widget :custom-state found))) (custom-magic-reset widget)) -;;; The `custom-save-all' Function. -;;;###autoload -(defcustom custom-file "~/.emacs" - "File used for storing customization information. -If you change this from the default \"~/.emacs\" you need to -explicitly load that file for the settings to take effect." - :type 'file - :group 'customize) - (defun custom-save-delete (symbol) "Delete the call to SYMBOL form in `custom-file'. Leave point at the location of the call, or after the last expression." @@ -3280,7 +3390,7 @@ Leave point at the location of the call, or after the last expression." (unless (bolp) (princ "\n")) (princ "(custom-set-variables") - (mapatoms (lambda (symbol) + (mapatoms (lambda (symbol) (let ((spec (car-safe (get symbol 'theme-value))) (requests (get symbol 'custom-requests)) (now (not (or (get symbol 'standard-value) @@ -3354,7 +3464,8 @@ Leave point at the location of the call, or after the last expression." (defun custom-save-resets (property setter special) (let (started-writing ignored-special) - ;; (custom-save-delete setter) Done by caller + (setq ignored-special ignored-special) ;; suppress byte-compiler warning + ;; (custom-save-delete setter) Done by caller (let ((standard-output (current-buffer)) (mapper `(lambda (object) (let ((spec (car-safe (get object (quote ,property))))) @@ -3377,8 +3488,9 @@ Leave point at the location of the call, or after the last expression." (setq ignored-special special) (mapatoms mapper) (when started-writing - (princ ")\n"))))) - + (princ ")\n")))) + ) + (defun custom-save-loaded-themes () (let ((themes (reverse (get 'user 'theme-loads-themes))) @@ -3389,7 +3501,7 @@ Leave point at the location of the call, or after the last expression." (mapc (lambda (theme) (princ "\n '") (prin1 theme)) themes) - (princ " )\n")))) + (princ " )\n")))) ;;;###autoload (defun customize-save-customized () @@ -3594,6 +3706,19 @@ if that value is non-nil." (run-hooks 'custom-mode-hook)) +;;;###autoload +(defun custom-migrate-custom-file (new-custom-file-name) + "Migrate custom file from home directory." + (mapc 'custom-save-delete + '(custom-load-themes custom-reset-variables + custom-set-variables + custom-set-faces + custom-reset-faces)) + (with-current-buffer (find-file-noselect custom-file) + (save-buffer)) + (setq custom-file new-custom-file-name) + (custom-save-all)) + ;;; The End. (provide 'cus-edit)