# HG changeset patch # User Aidan Kehoe # Date 1258297193 0 # Node ID 17f7e9191c0b5ff234091cfcf43267a26583b2b9 # Parent 776bbf454f3adec6a430d72c7e9efd67e85e6545 Rationalise duplicated functionality, #'custom-quote, #'quote-maybe. src/ChangeLog addition: 2009-11-15 Aidan Kehoe * eval.c (Fquote_maybe): Move this function here from callint.c; make it more comprehensive about which types are self-quoting. * lisp.h: Declare Fquote_maybe here, since it's now used in callint.c and defined in eval.c * callint.c (Fquote_maybe): Remove this function from this file. lisp/ChangeLog addition: 2009-11-15 Aidan Kehoe * custom.el (custom-quote): Define this as an alias for `quote-maybe', which is in C and more comprehensive; packages still use this name in places. (customize-mark-to-save, customize-mark-as-set): Use `quote-maybe', not `custom-quote'. * cus-edit.el (customize-set-variable, customize-save-variable) (custom-variable-value-create, custom-variable-set) (custom-variable-pre-save): Remove a version of `custom-quote' specific to this file; use `quote-maybe' universally instead. diff -r 776bbf454f3a -r 17f7e9191c0b lisp/ChangeLog --- a/lisp/ChangeLog Sat Nov 14 13:33:52 2009 +0000 +++ b/lisp/ChangeLog Sun Nov 15 14:59:53 2009 +0000 @@ -1,3 +1,16 @@ +2009-11-15 Aidan Kehoe + + * custom.el (custom-quote): + Define this as an alias for `quote-maybe', which is in C and more + comprehensive; packages still use this name in places. + (customize-mark-to-save, customize-mark-as-set): Use + `quote-maybe', not `custom-quote'. + * cus-edit.el (customize-set-variable, customize-save-variable) + (custom-variable-value-create, custom-variable-set) + (custom-variable-pre-save): + Remove a version of `custom-quote' specific to this file; use + `quote-maybe' universally instead. + 2009-11-14 Aidan Kehoe * bytecomp.el (byte-compile-funarg-n): diff -r 776bbf454f3a -r 17f7e9191c0b lisp/cus-edit.el --- a/lisp/cus-edit.el Sat Nov 14 13:33:52 2009 +0000 +++ b/lisp/cus-edit.el Sun Nov 15 14:59:53 2009 +0000 @@ -269,19 +269,6 @@ ;;; Utilities. -(defun custom-quote (sexp) - "Quote SEXP iff it is not self quoting." - (if (or (memq sexp '(t nil)) - (keywordp sexp) - (eq (car-safe sexp) 'lambda) - (stringp sexp) - (numberp sexp) - (characterp sexp) - (vectorp sexp) - (bit-vector-p sexp)) - sexp - (list 'quote sexp))) - (defun custom-split-regexp-maybe (regexp) "If REGEXP is a string, split it to a list at `\\|'. You can get the original back with from the result with: @@ -732,7 +719,7 @@ "Set customized value of %s" current-prefix-arg)) (funcall (or (get variable 'custom-set) 'set-default) variable value) - (put variable 'customized-value (list (custom-quote value))) + (put variable 'customized-value (list (quote-maybe value))) (cond ((string= comment "") (put variable 'variable-comment nil) (put variable 'customized-variable-comment nil)) @@ -761,8 +748,8 @@ "Set and save value of %s" current-prefix-arg)) (funcall (or (get variable 'custom-set) 'set-default) variable value) - (put variable 'saved-value (list (custom-quote value))) - (custom-push-theme 'theme-value variable 'user 'set (list (custom-quote value))) + (put variable 'saved-value (list (quote-maybe value))) + (custom-push-theme 'theme-value variable 'user 'set (list (quote-maybe value))) (cond ((string= comment "") (put variable 'variable-comment nil) (put variable 'saved-variable-comment nil)) @@ -2112,9 +2099,9 @@ ((get symbol 'standard-value) (car (get symbol 'standard-value))) ((default-boundp symbol) - (custom-quote (funcall get symbol))) + (quote-maybe (funcall get symbol))) (t - (custom-quote (widget-get conv :value)))))) + (quote-maybe (widget-get conv :value)))))) (insert (symbol-name symbol) ": ") (push (widget-create-child-and-convert widget 'visibility @@ -2353,7 +2340,7 @@ (set-extent-property (widget-get comment-widget :comment-extent) 'invisible t)) (funcall set symbol (setq val (widget-value child))) - (put symbol 'customized-value (list (custom-quote val))) + (put symbol 'customized-value (list (quote-maybe val))) (put symbol 'variable-comment comment) (put symbol 'customized-variable-comment comment))) (custom-variable-state-set widget) @@ -2393,11 +2380,11 @@ (set-extent-property (widget-get comment-widget :comment-extent) 'invisible t)) (put symbol - 'saved-value (list (custom-quote (widget-value - child)))) + 'saved-value (list (quote-maybe (widget-value + child)))) (custom-push-theme 'theme-value symbol 'user - 'set (list (custom-quote (widget-value - child)))) + 'set (list (quote-maybe (widget-value + child)))) (funcall set symbol (widget-value child)) (put symbol 'variable-comment comment) (put symbol 'saved-variable-comment comment))) diff -r 776bbf454f3a -r 17f7e9191c0b lisp/custom.el --- a/lisp/custom.el Sat Nov 14 13:33:52 2009 +0000 +++ b/lisp/custom.el Sun Nov 15 14:59:53 2009 +0000 @@ -820,20 +820,8 @@ (set variable value)) (set-default variable value))) -(defun custom-quote (sexp) - "Quote SEXP iff it is not self quoting." - (if (or (memq sexp '(t nil)) - (keywordp sexp) - (and (listp sexp) - (memq (car sexp) '(lambda))) - (stringp sexp) - (numberp sexp) - (vectorp sexp) -;;; (and (fboundp 'characterp) -;;; (characterp sexp)) - ) - sexp - (list 'quote sexp))) +;; Now in C, but the old name is still used by some packages: +(defalias 'custom-quote 'quote-maybe) (defun customize-mark-to-save (symbol) "Mark SYMBOL for later saving. @@ -855,7 +843,7 @@ (not (equal value (condition-case nil (eval (car standard)) (error nil))))) - (put symbol 'saved-value (list (custom-quote value))) + (put symbol 'saved-value (list (quote-maybe value))) (put symbol 'saved-value nil)) ;; Clear customized information (set, but not saved). (put symbol 'customized-value nil) @@ -882,7 +870,7 @@ (not (equal value (condition-case nil (eval (car old)) (error nil))))) - (put symbol 'customized-value (list (custom-quote value))) + (put symbol 'customized-value (list (quote-maybe value))) (put symbol 'customized-value nil)) ;; Changed? (not (equal customized (get symbol 'customized-value))))) diff -r 776bbf454f3a -r 17f7e9191c0b src/ChangeLog --- a/src/ChangeLog Sat Nov 14 13:33:52 2009 +0000 +++ b/src/ChangeLog Sun Nov 15 14:59:53 2009 +0000 @@ -1,3 +1,12 @@ +2009-11-15 Aidan Kehoe + + * eval.c (Fquote_maybe): + Move this function here from callint.c; make it more comprehensive + about which types are self-quoting. + * lisp.h: Declare Fquote_maybe here, since it's now used in + callint.c and defined in eval.c + * callint.c (Fquote_maybe): Remove this function from this file. + 2009-11-11 Stephen Turnbull * darwin.h: Remove. Functionality implemented in configure.ac. diff -r 776bbf454f3a -r 17f7e9191c0b src/callint.c --- a/src/callint.c Sat Nov 14 13:33:52 2009 +0000 +++ b/src/callint.c Sun Nov 15 14:59:53 2009 +0000 @@ -213,27 +213,6 @@ return Qnil; } -/* Originally, this was just a function -- but `custom' used a - garden-variety version, so why not make it a subr? */ -/* #### Move it to another file! */ -DEFUN ("quote-maybe", Fquote_maybe, 1, 1, 0, /* -Quote EXPR if it is not self quoting. -*/ - (expr)) -{ - return ((NILP (expr) - || EQ (expr, Qt) - || INTP (expr) - || FLOATP (expr) - || CHARP (expr) - || STRINGP (expr) - || VECTORP (expr) - || KEYWORDP (expr) - || BIT_VECTORP (expr) - || (CONSP (expr) && EQ (XCAR (expr), Qlambda))) - ? expr : list2 (Qquote, expr)); -} - /* Modify EXPR by quotifying each element (except the first). */ static Lisp_Object quotify_args (Lisp_Object expr) @@ -1048,7 +1027,6 @@ #endif DEFSUBR (Finteractive); - DEFSUBR (Fquote_maybe); DEFSUBR (Fcall_interactively); DEFSUBR (Fprefix_numeric_value); } diff -r 776bbf454f3a -r 17f7e9191c0b src/eval.c --- a/src/eval.c Sat Nov 14 13:33:52 2009 +0000 +++ b/src/eval.c Sun Nov 15 14:59:53 2009 +0000 @@ -1254,6 +1254,56 @@ return XCAR (args); } +/* Originally, this was just a function -- but `custom' used a garden- + variety version, so why not make it a subr? */ +DEFUN ("quote-maybe", Fquote_maybe, 1, 1, 0, /* +Quote EXPR if it is not self quoting. + +In contrast with `quote', this is a function, not a special form; its +argument is evaluated before `quote-maybe' is called. It returns either +EXPR (if it is self-quoting) or a list `(quote EXPR)' if it is not +self-quoting. Lists starting with the symbol `lambda' are regarded as +self-quoting. +*/ + (expr)) +{ + if ((XTYPE (expr)) == Lisp_Type_Record) + { + switch (XRECORD_LHEADER (expr)->type) + { + case lrecord_type_symbol: + if (NILP (expr) || (EQ (expr, Qt)) || SYMBOL_IS_KEYWORD (expr)) + { + return expr; + } + break; + case lrecord_type_cons: + if (EQ (XCAR (expr), Qlambda)) + { + return expr; + } + break; + + case lrecord_type_vector: + case lrecord_type_string: + case lrecord_type_compiled_function: + case lrecord_type_bit_vector: + case lrecord_type_float: + case lrecord_type_hash_table: + case lrecord_type_char_table: + case lrecord_type_range_table: + case lrecord_type_bignum: + case lrecord_type_ratio: + case lrecord_type_bigfloat: + return expr; + } + return list2 (Qquote, expr); + } + + /* Fixnums and characters are self-quoting: */ + return expr; +} + DEFUN ("function", Ffunction, 1, UNEVALLED, 0, /* Return the argument, without evaluating it. `(function x)' yields `x'. @@ -7260,6 +7310,7 @@ DEFSUBR (Fprog2); DEFSUBR (Fsetq); DEFSUBR (Fquote); + DEFSUBR (Fquote_maybe); DEFSUBR (Ffunction); DEFSUBR (Fdefun); DEFSUBR (Fdefmacro); diff -r 776bbf454f3a -r 17f7e9191c0b src/lisp.h --- a/src/lisp.h Sat Nov 14 13:33:52 2009 +0000 +++ b/src/lisp.h Sun Nov 15 14:59:53 2009 +0000 @@ -4267,6 +4267,7 @@ EXFUN (Fbacktrace, 2); EXFUN (Fcommand_execute, 3); EXFUN (Fcommandp, 1); +EXFUN (Fquote_maybe, 1); MODULE_API EXFUN (Feval, 1); MODULE_API EXFUN (Ffuncall, MANY); EXFUN (Ffunctionp, 1);