Mercurial > hg > xemacs-beta
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))))))