9:35 p.m.
At the moment, defcustom forms are compiled with the value expression
uncompiled, which, given how much slower uncompiled code is in XEmacs, is a
loss for us if complex expressions are given, which is routine. This byte
compiles those expressions. It also byte compiles any #'-quoted or unquoted
lambdas in the arguments, which is something GNU does (but they don’t *do*
the former right now, though they are discussing it). Their bytecomp.el has,
beyond this, lots of functionality that it should be worth merging--nothing
huge, but helpful all the same.
lisp/ChangeLog addition:
2007-11-15 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecomp.el (byte-compile-file-form-custom-declare-variable):
Byte compile the DEFAULT argument to custom-declare-variable, to
speed up complex expressions; also byte compile any lambda
expressions in the argument list.
XEmacs Trunk source patch:
Diff command: cvs -q diff -Nu
Files affected: lisp/bytecomp.el
===================================================================
RCS
Index: lisp/bytecomp.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/bytecomp.el,v
retrieving revision 1.20
diff -u -u -r1.20 bytecomp.el
--- lisp/bytecomp.el 2007/05/12 10:17:01 1.20
+++ lisp/bytecomp.el 2007/11/15 21:24:51
＠＠ -2376,13 +2376,33 ＠＠
(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 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 the default value, as we do for defvar.
+ (when (consp to-examine)
+ (setq form (copy-sequence form))
+ (setcdr (third form)
+ (list (byte-compile-top-level to-examine nil 'file))))
+ ;; 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)))))
+ form))
;;;###autoload
(defun byte-compile (form)
--
On the quay of the little Black Sea port, where the rescued pair came once
more into contact with civilization, Dobrinton was bitten by a dog which was
assumed to be mad, though it may only have been indiscriminating. (Saki)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
10:23 p.m.
New subject: [COMMIT] Byte compile defcustom init values; save the Lisp values for correct editing
SUPERSEDES 18236.48008.118955.91676(a)parhasard.net
APPROVE COMMIT
NOTE: This patch has been committed.
lisp/ChangeLog addition:
2007-11-27 Aidan Kehoe <kehoea(a)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.
XEmacs Trunk source patch:
Diff command: cvs -q diff -Nu
Files affected: lisp/custom.el
===================================================================
RCS lisp/cus-edit.el
===================================================================
RCS lisp/bytecomp.el
===================================================================
RCS
Index: lisp/bytecomp.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/bytecomp.el,v
retrieving revision 1.20
diff -u -u -r1.20 bytecomp.el
--- lisp/bytecomp.el 2007/05/12 10:17:01 1.20
+++ lisp/bytecomp.el 2007/11/27 22:00:46
＠＠ -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)
Index: lisp/cus-edit.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/cus-edit.el,v
retrieving revision 1.26
diff -u -u -r1.26 cus-edit.el
--- lisp/cus-edit.el 2007/11/08 14:43:40 1.26
+++ lisp/cus-edit.el 2007/11/27 22:00:47
＠＠ -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
Index: lisp/custom.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/custom.el,v
retrieving revision 1.14
diff -u -u -r1.14 custom.el
--- lisp/custom.el 2007/06/21 13:39:10 1.14
+++ lisp/custom.el 2007/11/27 22:00:47
＠＠ -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))))))
--
¿Dónde estará ahora mi sobrino Yoghurtu Nghé, que tuvo que huir
precipitadamente de la aldea por culpa de la escasez de rinocerontes?
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
6266
days inactive
6278
days old
1 comments
1 participants
participants (1)
-
Aidan Kehoe