changeset 4744:17f7e9191c0b

Rationalise duplicated functionality, #'custom-quote, #'quote-maybe. src/ChangeLog addition: 2009-11-15 Aidan Kehoe <kehoea@parhasard.net> * 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 <kehoea@parhasard.net> * 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.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 15 Nov 2009 14:59:53 +0000
parents 776bbf454f3a
children 0c54de4c4b9d
files lisp/ChangeLog lisp/cus-edit.el lisp/custom.el src/ChangeLog src/callint.c src/eval.c src/lisp.h
diffstat 7 files changed, 88 insertions(+), 61 deletions(-) [+]
line wrap: on
line diff
--- 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  <kehoea@parhasard.net>
+
+	* 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  <kehoea@parhasard.net>
 
 	* bytecomp.el (byte-compile-funarg-n): 
--- 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)))
--- 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)))))
--- 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  <kehoea@parhasard.net>
+
+	* 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  <stephen@xemacs.org>
 
 	* darwin.h: Remove.  Functionality implemented in configure.ac.
--- 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);
 }
--- 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);
--- 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);