CVS update by aidan xemacs/lisp ...
xemacs-cvs at xemacs.org
xemacs-cvs at xemacs.org
Tue Nov 27 17:15:40 EST 2007
User: aidan
Date: 07/11/27 23:15:40
Modified: xemacs/lisp ChangeLog bytecomp.el cus-edit.el custom.el
Log:
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.
Revision Changes Path
1.863 +30 -0 XEmacs/xemacs/lisp/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.862
retrieving revision 1.863
diff -u -p -r1.862 -r1.863
--- ChangeLog 2007/11/27 15:38:39 1.862
+++ ChangeLog 2007/11/27 22:15:32 1.863
@@ -1,5 +1,35 @@
2007-11-27 Aidan Kehoe <kehoea at 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 at parhasard.net>
+
* byte-optimize.el (byte-optimize-featurep):
Remove a useless let binding that was a hangover from an earlier
version of the code. Eliminates a byte-compile time warning.
1.21 +34 -7 XEmacs/xemacs/lisp/bytecomp.el
Index: bytecomp.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/bytecomp.el,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -p -r1.20 -r1.21
--- bytecomp.el 2007/05/12 10:17:01 1.20
+++ bytecomp.el 2007/11/27 22:15:34 1.21
@@ -2376,13 +2376,40 @@ list that represents a doc string refere
(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)
1.27 +49 -46 XEmacs/xemacs/lisp/cus-edit.el
Index: cus-edit.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/cus-edit.el,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -p -r1.26 -r1.27
--- cus-edit.el 2007/11/08 14:43:40 1.26
+++ cus-edit.el 2007/11/27 22:15:34 1.27
@@ -825,7 +825,8 @@ The default group is `Emacs'."
(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 @@ This means, in other words, variables de
(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 @@ Otherwise, look up symbol in `custom-gue
(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 @@ Match frames with dark backgrounds")
(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 @@ Creating group members... %2d%%"
(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
1.15 +16 -4 XEmacs/xemacs/lisp/custom.el
Index: custom.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/custom.el,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -p -r1.14 -r1.15
--- custom.el 2007/06/21 13:39:10 1.14
+++ custom.el 2007/11/27 22:15:34 1.15
@@ -116,9 +116,11 @@ Like `custom-initialize-set', but use th
(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 @@ DEFAULT is stored as SYMBOL's value in t
`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 @@ set to nil, as the value is no longer ro
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))))))
More information about the XEmacs-CVS
mailing list