all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* [PATCH] Custom saving improvement
@ 2003-01-30 22:50 Didier Verna
  0 siblings, 0 replies; only message in thread
From: Didier Verna @ 2003-01-30 22:50 UTC (permalink / raw)



        	Hi !

        Currently, saving a customization buffer implies saving the whole
world once for each widget. The following patch turns the saving cost (in
terms of 'mapatoms, mainly) from O(N) to O(1), by making only one call to
'custom-save-all for the whole buffer.



lisp/ChangeLog addition:

2003-01-30  Didier Verna  <didier@xemacs.org>

	* cus-edit.el (custom-variable): Declare
	(pre|post)-(save|reset-standard) widget methods.
	* cus-edit.el (custom-face): Ditto.
	* cus-edit.el (custom-group): Ditto.
	* cus-edit.el (custom-variable-pre-save): New function.
	* cus-edit.el (custom-variable-post-save): New function.
	* cus-edit.el (custom-variable-save): Use them.
	* cus-edit.el (custom-variable-pre-reset-standard): New function.
	* cus-edit.el (custom-variable-post-reset-standard): New function.
	* cus-edit.el (custom-variable-reset-standard): Use them.
	* cus-edit.el (custom-face-pre-save): New function.
	* cus-edit.el (custom-face-post-save): New function.
	* cus-edit.el (custom-face-save): Use them.
	* cus-edit.el (custom-face-pre-reset-standard): New function.
	* cus-edit.el (custom-face-post-reset-standard): New function.
	* cus-edit.el (custom-face-reset-standard): Use them.
	* cus-edit.el (custom-group-pre-save): New function.
	* cus-edit.el (custom-group-post-save): New function.
	* cus-edit.el (custom-group-pre-reset-standard): New function.
	* cus-edit.el (custom-group-post-reset-standard): New function.
	* cus-edit.el (Custom-save): Use (pre|post)-save widget methods,
	hence calling 'custom-save-all only once.
	* cus-edit.el (Custom-reset-standard): Ditto.


GNU Emacs source patch:
Diff command:   runsocks cvs -q diff -u
Files affected: lisp/cus-edit.el

Index: lisp/cus-edit.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/cus-edit.el,v
retrieving revision 1.177
diff -u -u -r1.177 cus-edit.el
--- lisp/cus-edit.el	29 Jan 2003 21:44:18 -0000	1.177
+++ lisp/cus-edit.el	30 Jan 2003 18:05:26 -0000
@@ -639,15 +639,24 @@
 	    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 changed rogue))
-	      (widget-apply child :custom-save)))
-	    children))
-  (custom-save-all))
+	    (when (memq (widget-get child :custom-state) '(modified set changed rogue))
+	      (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)
@@ -693,13 +702,24 @@
 This operation eliminates any saved settings for the group members,
 making them as if they had never been customized at all."
   (interactive)
-  (let ((children custom-options))
-    (mapc (lambda (widget)
-	    (and (widget-apply widget :custom-standard-value)
-		 (if (memq (widget-get widget :custom-state)
-			   '(modified set changed saved rogue))
-		     (widget-apply widget :custom-reset-standard))))
-	    children)))
+  (let ((all-children custom-options)
+	children must-save)
+    (mapc (lambda (child)
+	    (when (memq (widget-get child :custom-state) '(modified set changed saved rogue))
+	      (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
 
@@ -2031,10 +2051,14 @@
   :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-pre-reset-standard 'custom-variable-pre-reset-standard
   :custom-reset-standard 'custom-variable-reset-standard
+  :custom-post-reset-standard 'custom-variable-post-reset-standard
   :custom-standard-value 'custom-variable-standard-value)
 
 (defun custom-variable-type (symbol)
@@ -2179,7 +2203,7 @@
       ;; before the call to `widget-default-format-handler'. Otherwise, I
       ;; loose my current `buttons'. This function shouldn't be called like
       ;; this anyway. The doc string widget should be added like the others.
-      ;; --dv
+      ;; -- didier
       (widget-put widget :buttons buttons)
       (insert "\n")
       ;; Insert documentation.
@@ -2371,8 +2395,8 @@
     (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)))
@@ -2411,10 +2435,18 @@
 	   (put symbol 'variable-comment comment)
 	   (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)))
+    (put symbol 'customized-variable-comment nil)))
+
+(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.
@@ -2439,12 +2471,9 @@
     ;; 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 operation eliminates any saved setting for the variable,
-restoring it to the state of a variable that has never been customized.
-The value that was current before this operation
-becomes the backup value, so you can get it again."
+(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)))
@@ -2464,10 +2493,25 @@
       (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.
+This operation eliminates any saved setting for the variable,
+restoring it to the state of a variable that has never been customized.
+The value that was current before this operation
+becomes the backup value, so you can get it again."
+  (when (custom-variable-pre-reset-standard widget)
+    (custom-save-all))
+  (custom-variable-post-reset-standard widget))
 
 (defun custom-variable-backup-value (widget)
   "Back up the current value for WIDGET's variable.
@@ -2721,10 +2765,14 @@
   :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-standard-value 'custom-face-standard-value
   :custom-menu 'custom-face-menu-create)
 
@@ -3029,8 +3077,8 @@
   (custom-face-save widget)
   (custom-save-all))
 
-(defun custom-face-save (widget)
-  "Prepare for saving WIDGET's face attributes, but don't write `.emacs'."
+(defun custom-face-pre-save (widget)
+  "Prepare for saving the face edited by WIDGET."
   (let* ((symbol (widget-value widget))
 	 (child (car (widget-get widget :children)))
 	 (value (custom-post-filter-face-spec (widget-value child)))
@@ -3051,10 +3099,18 @@
     (put symbol 'customized-face nil)
     (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)))
+    (put symbol 'saved-face-comment comment)))
+
+(defun custom-face-post-save (widget)
+  "Finish saving the face 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."
@@ -3078,10 +3134,9 @@
 (defun custom-face-standard-value (widget)
   (get (widget-value widget) 'face-defface-spec))
 
-(defun custom-face-reset-standard (widget)
-  "Restore WIDGET to the face's standard settings.
-This operation eliminates any saved setting for the face,
-restoring it to the state of a face that has never been customized."
+(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))
@@ -3097,7 +3152,15 @@
       (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)
     (put symbol 'face-comment nil)
     (widget-value-set child value)
@@ -3106,6 +3169,14 @@
     (custom-face-state-set widget)
     (custom-redraw-magic widget)))
 
+(defun custom-face-reset-standard (widget)
+  "Restore WIDGET to the face's standard settings.
+This operation eliminates any saved setting for the face,
+restoring it to the state of a face that has never been customized."
+  (when (custom-face-pre-reset-standard widget)
+    (custom-save-all))
+  (custom-face-post-reset-standard widget))
+
 ;;; The `face' Widget.
 
 (define-widget 'face 'default
@@ -3248,10 +3319,14 @@
   :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)
@@ -3547,13 +3622,27 @@
 	      (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)))
-	    children )))
+	      (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."
@@ -3571,14 +3660,34 @@
 	      (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.
+(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)))
-	    children )))
+	      (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."

-- 
Didier Verna, didier@lrde.epita.fr, http://www.lrde.epita.fr/~didier

EPITA / LRDE, 14-16 rue Voltaire   Tel.+33 (1) 44 08 01 85
94276 Le Kremlin-Bicêtre, France   Fax.+33 (1) 53 14 59 22   didier@xemacs.org

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2003-01-30 22:50 UTC | newest]

Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2003-01-30 22:50 [PATCH] Custom saving improvement Didier Verna

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.