(require 'cus-load)
(require 'cus-start)
+(require 'cus-file)
;; Huh? This looks dirty!
(put 'custom-define-hook 'custom-type 'hook)
:group 'customize)
(defgroup alloc nil
- "Storage allocation and gc for GNU Emacs Lisp interpreter."
+ "Storage allocation and gc for XEmacs Lisp interpreter."
:tag "Storage Allocation"
:group 'internal)
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)))))
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)
(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)))
+ ))
\f
;;; The Customize Commands
(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.
(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.
`:prompt-value' property of that widget will be used for reading the value.
If given a prefix (or a COMMENT argument), also prompt for a comment."
- (interactive (custom-prompt-variable "Set and ave variable: "
+ (interactive (custom-prompt-variable "Set and save 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
(goto-char (point-min)))
(define-widget 'custom-browse-visibility 'item
- "Control visibility of of items in the customize tree browser."
+ "Control visibility of items in the customize tree browser."
:format "%[[%t]%]"
:action 'custom-browse-visibility-action)
: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.
;; 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)
;; Don't push it !!! Custom assumes that the first child is the
;; value one.
(setq children (append children (list comment-widget)))))
- ;; Update the rest of the properties properties.
+ ;; Update the rest of the properties.
(widget-put widget :custom-form form)
(widget-put widget :children children)
;; Now update the state.
(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)))
(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)
;; 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)))
(put symbol 'saved-value nil)
(custom-push-theme 'theme-value symbol 'user 'reset 'standard)
;; As a special optimizations we do not (explictly)
- ;; save resets to standard when no theme set the value.
+ ;; save resets to standard when no theme sets the value.
(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.
: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")
: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
(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))
(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))
(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)
(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.
: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)
(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)))
(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)
(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."
(custom-save-delete 'custom-set-variables)
(custom-save-loaded-themes)
(custom-save-resets 'theme-value 'custom-reset-variables nil)
+
(let ((standard-output (current-buffer)))
(unless (bolp)
- (princ "\n"))
+ (princ "\n"))
(princ "(custom-set-variables")
- (mapatoms (lambda (symbol)
- (let ((spec (car-safe (get symbol 'theme-value)))
- (requests (get symbol 'custom-requests))
- (now (not (or (get symbol 'standard-value)
- (and (not (boundp symbol))
- (not (eq (get symbol 'force-value)
- 'rogue))))))
- (comment (get symbol 'saved-variable-comment)))
- (when (or (and spec (eq (car spec) 'user)
- (eq (second spec) 'set)) comment)
- (princ "\n '(")
- (prin1 symbol)
- (princ " ")
- ;; This comment stuff is in the way ####
- ;; Is (eq (third spec) (car saved-value)) ????
- ;; (prin1 (third spec))
- (prin1 (car (get symbol 'saved-value)))
- (when (or now requests comment)
- (princ (if now " t" " nil")))
- (when (or comment requests)
- (princ " ")
- (prin1 requests))
- (when comment
- (princ " ")
- (prin1 comment))
- (princ ")")))))
- (princ ")")
- (unless (looking-at "\n")
- (princ "\n")))))
+
+ ;; Get the list of variables to save...
+ (let (varlist)
+ (mapatoms (lambda (symbol)
+ (let ((spec (car-safe (get symbol 'theme-value)))
+ (comment (get symbol 'saved-variable-comment)))
+ (when (or (and spec
+ (eq (first spec) 'user)
+ (eq (second spec) 'set))
+ comment
+ ;; support non-themed vars
+ (and (null spec) (get symbol 'saved-value)))
+ (push symbol varlist)))))
+
+ ;; ...and sort it by name, so our output can be easily diffed, etc.
+ (setq varlist (sort varlist #'string-lessp))
+
+ ;; Generate the output for each var.
+ (dolist (symbol varlist)
+ (let ((requests (get symbol 'custom-requests))
+ (now (not (or (get symbol 'standard-value)
+ (and (not (boundp symbol))
+ (not (eq (get symbol 'force-value)
+ 'rogue))))))
+ (comment (get symbol 'saved-variable-comment))
+ ;; Print everything, no placeholders `...'
+ (print-level nil)
+ (print-length nil))
+ (princ "\n '(")
+ (prin1 symbol)
+ (princ " ")
+ (prin1 (car (get symbol 'saved-value)))
+ (when (or now requests comment)
+ (princ (if now " t" " nil")))
+ (when (or comment requests)
+ (princ " ")
+ (prin1 requests))
+ (when comment
+ (princ " ")
+ (prin1 comment))
+ (princ ")"))))
+
+ ;; Finish the output.
+ (princ ")")
+ (unless (looking-at "\n")
+ (princ "\n")))))
(defvar custom-save-face-ignoring nil)
(comment (get symbol 'saved-face-comment))
(now (not (or (get symbol 'face-defface-spec)
(and (not (find-face symbol))
- (not (eq (get symbol 'force-face) 'rogue)))))))
+ (not (eq (get symbol 'force-face) 'rogue))))))
+ ;; Print everything, no placeholders `...'
+ (print-level nil)
+ (print-length nil))
(when (or (and (not (memq symbol custom-save-face-ignoring))
- ;; Don't print default face here.
- theme-spec
- (eq (car theme-spec) 'user)
- (eq (second theme-spec) 'set)) comment)
+ ;; Don't print default face here.
+ (or (and theme-spec
+ (eq (car theme-spec) 'user)
+ (eq (second theme-spec) 'set))
+ ;; cope with non-themed faces
+ (and (null theme-spec)
+ (get symbol 'saved-face))))
+ comment)
(princ "\n '(")
(prin1 symbol)
(princ " ")
(custom-save-delete 'custom-reset-faces)
(custom-save-delete 'custom-set-faces)
(custom-save-resets 'theme-face 'custom-reset-faces '(default))
- (let ((standard-output (current-buffer)))
+ (let ((standard-output (current-buffer))
+ (sorted-list ()))
+ ;; Create a sorted list of faces
+ (mapatoms
+ (lambda (symbol)
+ (let ((theme-spec (car-safe (get symbol 'theme-face)))
+ (comment (get symbol 'saved-face-comment)))
+ (when
+ (or (and (not (memq symbol custom-save-face-ignoring))
+ ;; Don't print default face here.
+ (or (and theme-spec
+ (eq (car theme-spec) 'user)
+ (eq (second theme-spec) 'set))
+ ;; cope with non-themed faces
+ (and (null theme-spec)
+ (get symbol 'saved-face))))
+ comment)
+ (push symbol sorted-list)))))
+ (setq sorted-list (sort sorted-list 'string<))
(unless (bolp)
(princ "\n"))
(princ "(custom-set-faces")
;; The default face must be first, since it affects the others.
(custom-save-face-internal 'default)
(let ((custom-save-face-ignoring '(default)))
- (mapatoms #'custom-save-face-internal))
+ (mapc 'custom-save-face-internal
+ sorted-list))
(princ ")")
(unless (looking-at "\n")
(princ "\n")))))
(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)))))
+ (let ((spec (car-safe (get object (quote ,property))))
+ (print-level nil)
+ (print-length nil))
(when (and (not (memq object ignored-special))
(eq (car spec) 'user)
(eq (second spec) 'reset))
(mapatoms mapper)
(when started-writing
(princ ")\n")))))
-
+
(defun custom-save-loaded-themes ()
(let ((themes (reverse (get 'user 'theme-loads-themes)))
- (standard-output (current-buffer)))
+ (standard-output (current-buffer))
+ (print-level nil)
+ (print-length nil))
(when themes
(unless (bolp) (princ "\n"))
(princ "(custom-load-themes")
(mapc (lambda (theme)
(princ "\n '")
(prin1 theme)) themes)
- (princ " )\n"))))
+ (princ " )\n"))))
;;;###autoload
(defun customize-save-customized ()
(run-hooks 'custom-mode-hook))
\f
+;;;###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))
+\f
;;; The End.
(provide 'cus-edit)
projects / chise / xemacs-chise.git.1 / blobdiff