changeset 4289:20accccbebd6

[xemacs-hg @ 2007-11-27 22:15:32 by aidan] Byte compile defcustom init values; save the Lisp values for correct editing, correct some comments and indentation, and expose some lambda expressions to the byte compile; make custom-initialize-changed a defubst, since it's only called from one place and calls to that place cluster.
author aidan
date Tue, 27 Nov 2007 22:15:34 +0000
parents 9eb558ffe8ff
children e2d8f3b8fb7d
files lisp/ChangeLog lisp/bytecomp.el lisp/cus-edit.el lisp/custom.el
diffstat 4 files changed, 129 insertions(+), 57 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Tue Nov 27 15:38:40 2007 +0000
+++ b/lisp/ChangeLog	Tue Nov 27 22:15:34 2007 +0000
@@ -1,3 +1,33 @@
+2007-11-27  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* bytecomp.el (byte-compile-file-form-custom-declare-variable):
+	Byte compile the default value for #'custom-declare-variable (and
+	thence defcustom) calls; pass the uncompiled value as the value of
+	a :default keyword, to be used in the customize UI if the byte
+	compiled init value differs from the non byte compiled init
+	value.
+
+	GNU don't do these things. The advantages of doing it our way are
+	a) the byte compilation warnings and b) since our interpreter is
+	proportionately so much slower than theirs, we are penalised more
+	strongly when we interpret code, especially when
+	#'custom-declare-variable calls cluster, as they tend to do. 
+	* cus-edit.el (customize-changed-options):
+	Wrap the #'interactive call to be less than 80 columns. 
+	Wrap the code to less than 80 columns.
+	* cus-edit.el (custom-variable-menu):
+	* cus-edit.el (custom-face-menu):
+	* cus-edit.el (custom-group-menu):
+	Expose the lambda expressions in these variables to the byte
+	compiler.
+	* custom.el (custom-initialize-changed):
+	Correct the docstring; change the defun to defsubst, since calls
+	to this are only done from one function, and calls to that
+	function cluster. 
+	* custom.el (custom-declare-variable):
+	Document the :default argument to #'custom-declare-variable;
+	implement it. 
+
 2007-11-27  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* byte-optimize.el (byte-optimize-featurep):
--- a/lisp/bytecomp.el	Tue Nov 27 15:38:40 2007 +0000
+++ b/lisp/bytecomp.el	Tue Nov 27 22:15:34 2007 +0000
@@ -2376,13 +2376,40 @@
 (put 'custom-declare-variable 'byte-hunk-handler
      'byte-compile-file-form-custom-declare-variable)
 (defun byte-compile-file-form-custom-declare-variable (form)
-  (if (memq 'free-vars byte-compile-warnings)
-      (setq byte-compile-bound-variables
-	    (cons (cons (nth 1 (nth 1 form))
-			byte-compile-global-bit)
-		  byte-compile-bound-variables)))
-  form)
-
+  ;; XEmacs change; our implementation byte compiles and gives warnings
+  ;; about the default value code, which GNU's doesn't.
+  (let* ((quoted-default (car-safe (cdr-safe (cdr-safe form))))
+         (to-examine (car-safe (cdr-safe quoted-default))))
+    (if (memq 'free-vars byte-compile-warnings)
+        (setq byte-compile-bound-variables
+              (cons (cons (nth 1 (nth 1 form))
+                          byte-compile-global-bit)
+                    byte-compile-bound-variables)))
+    ;; Byte compile anything that smells like a lambda. I initially
+    ;; considered limiting it to the :initialize, :set and :get args, but
+    ;; that's not amazingly forward-compatible, and anyone expecting other
+    ;; things to be stored as data, not code, is unrealistic. 
+     (loop
+       for entry in-ref (nthcdr 4 form)
+       do (cond ((and (eq 'function (car-safe entry))
+                      (consp (car-safe (cdr-safe entry))))
+                 (setf entry (copy-sequence entry))
+                 (setcar (cdr entry) (byte-compile-lambda (car (cdr entry)))))
+                ((and (eq 'lambda (car-safe entry)))
+                 (setf entry (byte-compile-lambda entry)))))
+     ;; Byte compile the default value, as we do for defvar. 
+     (when (consp (cdr-safe to-examine))
+       (setq form (copy-sequence form))
+       (setcdr (third form)
+               (list (byte-compile-top-level to-examine nil 'file)))
+       ;; And save a value to be examined in the custom UI, if that differs
+       ;; from the init value.
+       (unless (equal to-examine (car-safe (cdr (third form))))
+         (setf (nthcdr 4 form) (nconc
+                                (list :default 
+                                      (list 'quote to-examine))
+                                (nthcdr 4 form)))))
+    form))
 
 ;;;###autoload
 (defun byte-compile (form)
--- a/lisp/cus-edit.el	Tue Nov 27 15:38:40 2007 +0000
+++ b/lisp/cus-edit.el	Tue Nov 27 22:15:34 2007 +0000
@@ -825,7 +825,8 @@
 (defun customize-changed-options (since-version)
   "Customize all user option variables whose default values changed recently.
 This means, in other words, variables defined with a `:version' keyword."
-  (interactive "sCustomize options changed, since version (default all versions): ")
+  (interactive
+   "sCustomize options changed, since version (default all versions): ")
   (if (equal since-version "")
       (setq since-version nil))
   (let ((found nil))
@@ -834,7 +835,8 @@
 		     (let ((version (get symbol 'custom-version)))
 		       (and version
 			    (or (null since-version)
-				(customize-version-lessp since-version version))))
+				(customize-version-lessp since-version
+                                                         version))))
 		     (push (list symbol 'custom-variable) found))))
     (unless found
       (error "No user options have changed defaults %s"
@@ -2203,36 +2205,37 @@
     (widget-put widget :custom-state state)))
 
 (defvar custom-variable-menu
-  '(("Set for Current Session" custom-variable-set
-     (lambda (widget)
-       (eq (widget-get widget :custom-state) 'modified)))
+  `(("Set for Current Session" custom-variable-set
+     ,#'(lambda (widget)
+          (eq (widget-get widget :custom-state) 'modified)))
     ("Save for Future Sessions" custom-variable-save
-     (lambda (widget)
-       (memq (widget-get widget :custom-state) '(modified set changed rogue))))
+     ,#'(lambda (widget)
+          (memq (widget-get widget :custom-state)
+                '(modified set changed rogue))))
     ("Reset to Current" custom-redraw
-     (lambda (widget)
-       (and (default-boundp (widget-value widget))
-	    (memq (widget-get widget :custom-state) '(modified changed)))))
+     ,#'(lambda (widget)
+          (and (default-boundp (widget-value widget))
+               (memq (widget-get widget :custom-state) '(modified changed)))))
     ("Reset to Saved" custom-variable-reset-saved
-     (lambda (widget)
-       (and (or (get (widget-value widget) 'saved-value)
-		(get (widget-value widget) 'saved-variable-comment))
-	    (memq (widget-get widget :custom-state)
-		  '(modified set changed rogue)))))
+     ,#'(lambda (widget)
+          (and (or (get (widget-value widget) 'saved-value)
+                   (get (widget-value widget) 'saved-variable-comment))
+               (memq (widget-get widget :custom-state)
+                     '(modified set changed rogue)))))
     ("Reset to Standard Settings" custom-variable-reset-standard
-     (lambda (widget)
-       (and (get (widget-value widget) 'standard-value)
-	    (memq (widget-get widget :custom-state)
-		  '(modified set changed saved rogue)))))
+     ,#'(lambda (widget)
+          (and (get (widget-value widget) 'standard-value)
+               (memq (widget-get widget :custom-state)
+                     '(modified set changed saved rogue)))))
     ("---" ignore ignore)
     ("Add Comment" custom-comment-show custom-comment-invisible-p)
     ("---" ignore ignore)
     ("Don't show as Lisp expression" custom-variable-edit
-     (lambda (widget)
-       (eq (widget-get widget :custom-form) 'lisp)))
+     ,#'(lambda (widget)
+          (eq (widget-get widget :custom-form) 'lisp)))
     ("Show as Lisp expression" custom-variable-edit-lisp
-     (lambda (widget)
-       (eq (widget-get widget :custom-form) 'edit))))
+     ,#'(lambda (widget)
+          (eq (widget-get widget :custom-form) 'edit))))
   "Alist of actions for the `custom-variable' widget.
 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
 the menu entry, ACTION is the function to call on the widget when the
@@ -2694,27 +2697,27 @@
 	     (message "Creating face editor...done"))))))
 
 (defvar custom-face-menu
-  '(("Set for Current Session" custom-face-set)
+  `(("Set for Current Session" custom-face-set)
     ("Save for Future Sessions" custom-face-save)
     ("Reset to Saved" custom-face-reset-saved
-     (lambda (widget)
-       (or (get (widget-value widget) 'saved-face)
-	   (get (widget-value widget) 'saved-face-comment))))
+     ,#'(lambda (widget)
+          (or (get (widget-value widget) 'saved-face)
+              (get (widget-value widget) 'saved-face-comment))))
     ("Reset to Standard Setting" custom-face-reset-standard
-     (lambda (widget)
-       (get (widget-value widget) 'face-defface-spec)))
+     ,#'(lambda (widget)
+          (get (widget-value widget) 'face-defface-spec)))
     ("---" ignore ignore)
     ("Add Comment" custom-comment-show custom-comment-invisible-p)
     ("---" ignore ignore)
     ("Show all display specs" custom-face-edit-all
-     (lambda (widget)
-       (not (eq (widget-get widget :custom-form) 'all))))
+     ,#'(lambda (widget)
+          (not (eq (widget-get widget :custom-form) 'all))))
     ("Just current attributes" custom-face-edit-selected
-     (lambda (widget)
-       (not (eq (widget-get widget :custom-form) 'selected))))
+     ,#'(lambda (widget)
+          (not (eq (widget-get widget :custom-form) 'selected))))
     ("Show as Lisp expression" custom-face-edit-lisp
-     (lambda (widget)
-       (not (eq (widget-get widget :custom-form) 'lisp)))))
+     ,#'(lambda (widget)
+          (not (eq (widget-get widget :custom-form) 'lisp)))))
   "Alist of actions for the `custom-face' widget.
 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
 the menu entry, ACTION is the function to call on the widget when the
@@ -3336,21 +3339,21 @@
 	   (insert "/\n")))))
 
 (defvar custom-group-menu
-  '(("Set for Current Session" custom-group-set
-     (lambda (widget)
-       (eq (widget-get widget :custom-state) 'modified)))
+  `(("Set for Current Session" custom-group-set
+     ,#'(lambda (widget)
+          (eq (widget-get widget :custom-state) 'modified)))
     ("Save for Future Sessions" custom-group-save
-     (lambda (widget)
-       (memq (widget-get widget :custom-state) '(modified set))))
+     ,#'(lambda (widget)
+          (memq (widget-get widget :custom-state) '(modified set))))
     ("Reset to Current" custom-group-reset-current
-     (lambda (widget)
-       (memq (widget-get widget :custom-state) '(modified))))
+     ,#'(lambda (widget)
+          (memq (widget-get widget :custom-state) '(modified))))
     ("Reset to Saved" custom-group-reset-saved
-     (lambda (widget)
-       (memq (widget-get widget :custom-state) '(modified set))))
+     ,#'(lambda (widget)
+          (memq (widget-get widget :custom-state) '(modified set))))
     ("Reset to standard setting" custom-group-reset-standard
-     (lambda (widget)
-       (memq (widget-get widget :custom-state) '(modified set saved)))))
+     ,#'(lambda (widget)
+          (memq (widget-get widget :custom-state) '(modified set saved)))))
   "Alist of actions for the `custom-group' widget.
 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
 the menu entry, ACTION is the function to call on the widget when the
--- a/lisp/custom.el	Tue Nov 27 15:38:40 2007 +0000
+++ b/lisp/custom.el	Tue Nov 27 22:15:34 2007 +0000
@@ -116,9 +116,11 @@
                    (t
                     (eval value)))))
 
-(defun custom-initialize-changed (symbol value)
+;; XEmacs change; move to defsubst, since this is only called in one place
+;; and usage of it clusters.
+(defsubst custom-initialize-changed (symbol value)
   "Initialize SYMBOL with VALUE.
-Like `custom-initialize-reset', but only use the `:set' function if the
+Like `custom-initialize-reset', but only use the `:set' function if
 not using the standard setting.
 For the standard setting, use `set-default'."
   (cond ((default-boundp symbol)
@@ -142,9 +144,15 @@
 `custom-known-themes' for a list of known themes.  For backwards
 compatibility, DEFAULT is also stored in SYMBOL's property
 `standard-value'.  At the same time, SYMBOL's property `force-value' is
-set to nil, as the value is no longer rogue."
+set to nil, as the value is no longer rogue.
+
+The byte compiler adds an XEmacs-specific :default keyword and value to
+`custom-declare-variable' calls when it byte-compiles the DEFAULT argument.
+These describe what the custom UI shows when editing a customizable
+variable's associated Lisp expression.  We don't encourage use of this
+keyword in your own programs.  "
   ;; Remember the standard setting.  The value should be in the standard
-  ;; theme, not in this property.  However, his would require changeing
+  ;; theme, not in this property.  However, this would require changing
   ;; the C source of defvar and others as well...
   (put symbol 'standard-value (list default))
   ;; Maybe this option was rogue in an earlier version.  It no longer is.
@@ -184,6 +192,10 @@
 			   value)
 		   ;; Fast code for the common case.
 		   (put symbol 'custom-options (copy-sequence value))))
+                ;; In the event that the byte compile has compiled the init
+                ;; value, we want the value the UI sees to be uncompiled.
+                ((eq keyword :default)
+                 (put symbol 'standard-value (list value)))
 		(t
 		 (custom-handle-keyword symbol keyword value
 					'custom-variable))))))