changeset 5222:18c0b5909d16

Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1 src/ChangeLog addition: 2010-05-31 Aidan Kehoe <kehoea@parhasard.net> * rangetab.c (print_range_table, rangetab_instantiate) (structure_type_create_rangetab): * chartab.c (print_char_table, chartab_instantiate) (structure_type_create_chartab): * faces.c (syms_of_faces, print_face, face_validate): Move structure syntax in these files to using keywords by default, as is done in Common Lisp and GNU Emacs, accepting for the moment the older non-keywords syntax too. * glyphs.h: No need to have Q_data here. * general-slots.h: Add Q_data, Q_type here. * config.h.in (NEED_TO_HANDLE_21_4_CODE): New #define, always 1 for the moment, replacing the previous never-really-used NO_NEED_TO_HANDLE_21_4_CODE, and avoiding confusing syntax. * eval.c (Ffuncall): Wrap the hack that allows #'throw to be funcalled in #ifdef NEED_TO_HANDLE_21_4_CODE. * elhash.c (syms_of_elhash): Move Q_type, Q_data to general-slots.h. Change to NEED_TO_HANDLE_21_4_CODE throughout this file. lisp/ChangeLog addition: 2010-05-31 Aidan Kehoe <kehoea@parhasard.net> * specifier.el (current-display-table): Use keywords in the structure syntax here, now we've moved to that by default in C.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 31 May 2010 16:47:44 +0100
parents ac6846067766
children acc4a6c9f5f9
files lisp/ChangeLog lisp/specifier.el src/ChangeLog src/chartab.c src/config.h.in src/elhash.c src/eval.c src/faces.c src/general-slots.h src/glyphs.h src/rangetab.c src/symbols.c
diffstat 12 files changed, 150 insertions(+), 36 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sun May 30 15:16:07 2010 +0100
+++ b/lisp/ChangeLog	Mon May 31 16:47:44 2010 +0100
@@ -1,3 +1,9 @@
+2010-05-31  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* specifier.el (current-display-table):
+	Use keywords in the structure syntax here, now we've moved to that
+	by default in C.
+
 2010-05-30  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl.el: Remove extraneous empty lines.
--- a/lisp/specifier.el	Sun May 30 15:16:07 2010 +0100
+++ b/lisp/specifier.el	Mon May 31 16:47:44 2010 +0100
@@ -999,7 +999,7 @@
 ;; initialised; that's why this is here, and not in x-init.el, these days.
 
 (set-specifier current-display-table 
-               #s(char-table type generic data (?\xA0 ?\x20))
+               #s(char-table :type generic :data (?\xA0 ?\x20))
                'global)
 
 ;;; specifier.el ends here
--- a/src/ChangeLog	Sun May 30 15:16:07 2010 +0100
+++ b/src/ChangeLog	Mon May 31 16:47:44 2010 +0100
@@ -1,3 +1,29 @@
+2010-05-31  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* rangetab.c (print_range_table, rangetab_instantiate)
+	(structure_type_create_rangetab):
+	* chartab.c (print_char_table, chartab_instantiate)
+	(structure_type_create_chartab):
+	* faces.c (syms_of_faces, print_face, face_validate):
+
+	Move structure syntax in these files to using keywords by default,
+	as is done in Common Lisp and GNU Emacs, accepting for the moment
+	the older non-keywords syntax too.
+
+	* glyphs.h: No need to have Q_data here.
+	* general-slots.h: Add Q_data, Q_type here.
+
+	* config.h.in (NEED_TO_HANDLE_21_4_CODE):
+	New #define, always 1 for the moment, replacing the previous
+	never-really-used NO_NEED_TO_HANDLE_21_4_CODE, and avoiding
+	confusing syntax.
+	
+	* eval.c (Ffuncall): Wrap the hack that allows #'throw to be
+	funcalled in #ifdef NEED_TO_HANDLE_21_4_CODE.
+	* elhash.c (syms_of_elhash): Move Q_type, Q_data to
+	general-slots.h. Change to NEED_TO_HANDLE_21_4_CODE throughout
+	this file.
+
 2010-05-29  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* fontcolor-msw.c (mswindows_X_color_map): Sort this, case
--- a/src/chartab.c	Sun May 30 15:16:07 2010 +0100
+++ b/src/chartab.c	Mon May 31 16:47:44 2010 +0100
@@ -336,7 +336,7 @@
   arg.printcharfun = printcharfun;
   arg.first = 1;
 
-  write_fmt_string_lisp (printcharfun, "#s(char-table type %s data (",
+  write_fmt_string_lisp (printcharfun, "#s(char-table :type %s :data (",
 			 1, char_table_type_to_symbol (ct->type));
   map_char_table (obj, &range, print_table_entry, &arg);
   write_ascstring (printcharfun, "))");
@@ -1544,35 +1544,67 @@
 }
 
 static Lisp_Object
-chartab_instantiate (Lisp_Object data)
+chartab_instantiate (Lisp_Object plist)
 {
   Lisp_Object chartab;
   Lisp_Object type = Qgeneric;
   Lisp_Object dataval = Qnil;
 
-  while (!NILP (data))
+  if (KEYWORDP (Fcar (plist)))
     {
-      Lisp_Object keyw = Fcar (data);
-      Lisp_Object valw;
-
-      data = Fcdr (data);
-      valw = Fcar (data);
-      data = Fcdr (data);
-      if (EQ (keyw, Qtype))
-	type = valw;
-      else if (EQ (keyw, Qdata))
-	dataval = valw;
+      PROPERTY_LIST_LOOP_3 (key, value, plist)
+	{
+	  if (EQ (key, Q_data))
+	    {
+	      dataval = value;
+	    }
+	  else if (EQ (key, Q_type))
+	    {
+	      type = value;
+	    }
+	  else if (!KEYWORDP (key))
+	    {
+	      signal_error
+		(Qinvalid_read_syntax, 
+		 "can't mix keyword and non-keyword structure syntax",
+		 key);
+	    }
+	  else 
+	    ABORT ();
+	}
     }
+#ifdef NEED_TO_HANDLE_21_4_CODE
+  else
+    {
+      PROPERTY_LIST_LOOP_3 (key, value, plist)
+	{
+	  if (EQ (key, Qdata))
+	    {
+	      dataval = value;
+	    }
+	  else if (EQ (key, Qtype))
+	    {
+	      type = value;
+	    }
+	  else if (KEYWORDP (key))
+            signal_error
+	      (Qinvalid_read_syntax, 
+	       "can't mix keyword and non-keyword structure syntax",
+	       key);
+	  else 
+	    ABORT ();
+	}
+    }
+#endif /* NEED_TO_HANDLE_21_4_CODE */
 
   chartab = Fmake_char_table (type);
 
-  data = dataval;
-  while (!NILP (data))
+  while (!NILP (dataval))
     {
-      Lisp_Object range = Fcar (data);
-      Lisp_Object val = Fcar (Fcdr (data));
+      Lisp_Object range = Fcar (dataval);
+      Lisp_Object val = Fcar (Fcdr (dataval));
 
-      data = Fcdr (Fcdr (data));
+      dataval = Fcdr (Fcdr (dataval));
       if (CONSP (range))
         {
 	  if (CHAR_OR_CHAR_INTP (XCAR (range)))
@@ -1887,8 +1919,13 @@
 
   st = define_structure_type (Qchar_table, 0, chartab_instantiate);
 
+#ifdef NEED_TO_HANDLE_21_4_CODE
   define_structure_type_keyword (st, Qtype, chartab_type_validate);
   define_structure_type_keyword (st, Qdata, chartab_data_validate);
+#endif /* NEED_TO_HANDLE_21_4_CODE */
+
+  define_structure_type_keyword (st, Q_type, chartab_type_validate);
+  define_structure_type_keyword (st, Q_data, chartab_data_validate);
 }
 
 void
--- a/src/config.h.in	Sun May 30 15:16:07 2010 +0100
+++ b/src/config.h.in	Mon May 31 16:47:44 2010 +0100
@@ -1184,4 +1184,7 @@
 #define XEMACS_DEFS_NEEDS_INLINE_DECLS
 #endif
 
+/* Do we need to be able to run code compiled by and written for 21.4? */
+#define NEED_TO_HANDLE_21_4_CODE 1
+
 #endif /* _SRC_CONFIG_H_ */
--- a/src/elhash.c	Sun May 30 15:16:07 2010 +0100
+++ b/src/elhash.c	Mon May 31 16:47:44 2010 +0100
@@ -99,7 +99,7 @@
 
 /* obsolete as of 19990901 in xemacs-21.2 */
 static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_or_value_weak;
-static Lisp_Object Qnon_weak, Q_type, Q_data;
+static Lisp_Object Qnon_weak;
 
 /* A hash table test, with its associated hash function. equal_function may
    call lisp_equal_function, and hash_function similarly may call
@@ -757,7 +757,7 @@
   if (EQ (value, Qkey_or_value))	return 1;
   if (EQ (value, Qvalue))		return 1;
 
-#ifndef NO_NEED_TO_HANDLE_21_4_CODE
+#ifdef NEED_TO_HANDLE_21_4_CODE
   /* Following values are obsolete as of 19990901 in xemacs-21.2 */
   if (EQ (value, Qnon_weak))		return 1;
   if (EQ (value, Qweak))		return 1;
@@ -781,7 +781,7 @@
   if (EQ (obj, Qkey_or_value))		return HASH_TABLE_KEY_VALUE_WEAK;
   if (EQ (obj, Qvalue))			return HASH_TABLE_VALUE_WEAK;
 
-#ifndef NO_NEED_TO_HANDLE_21_4_CODE
+#ifdef NEED_TO_HANDLE_21_4_CODE
   /* Following values are obsolete as of 19990901 in xemacs-21.2 */
   if (EQ (obj, Qnon_weak))		return HASH_TABLE_NON_WEAK;
   if (EQ (obj, Qweak))			return HASH_TABLE_WEAK;
@@ -1015,6 +1015,7 @@
   define_structure_type_keyword (st, Q_weakness, hash_table_weakness_validate);
   define_structure_type_keyword (st, Q_data, hash_table_data_validate);
 
+#ifdef NEED_TO_HANDLE_21_4_CODE
   /* Next the mutually exclusive, older, non-keyword syntax: */
   define_structure_type_keyword (st, Qtest, hash_table_test_validate);
   define_structure_type_keyword (st, Qsize, hash_table_size_validate);
@@ -1023,7 +1024,6 @@
   define_structure_type_keyword (st, Qweakness, hash_table_weakness_validate);
   define_structure_type_keyword (st, Qdata, hash_table_data_validate);
 
-#ifndef NO_NEED_TO_HANDLE_21_4_CODE
   /* obsolete as of 19990901 in xemacs-21.2 */
   define_structure_type_keyword (st, Qtype, hash_table_weakness_validate);
 #endif
@@ -1037,7 +1037,9 @@
 structure_type_create_hash_table (void)
 {
   structure_type_create_hash_table_structure_name (Qhash_table);
+#ifdef NEED_TO_HANDLE_21_4_CODE
   structure_type_create_hash_table_structure_name (Qhashtable); /* compat */
+#endif
 }
 
 
@@ -2277,7 +2279,6 @@
   DEFKEYWORD (Q_rehash_size);
   DEFKEYWORD (Q_rehash_threshold);
   DEFKEYWORD (Q_weakness);
-  DEFKEYWORD (Q_type); /* obsolete */
 }
 
 void
--- a/src/eval.c	Sun May 30 15:16:07 2010 +0100
+++ b/src/eval.c	Mon May 31 16:47:44 2010 +0100
@@ -4117,12 +4117,16 @@
 	}
       else if (max_args == UNEVALLED) /* Can't funcall a special operator */
 	{
+
+#ifdef NEED_TO_HANDLE_21_4_CODE
           /* Ugh, ugh, ugh. */
           if (EQ (fun, XSYMBOL_FUNCTION (Qthrow)))
             {
               args[0] = Qobsolete_throw;
               goto retry;
             }
+#endif /* NEED_TO_HANDLE_21_4_CODE */
+
 	  goto invalid_function;
 	}
       else
--- a/src/faces.c	Sun May 30 15:16:07 2010 +0100
+++ b/src/faces.c	Mon May 31 16:47:44 2010 +0100
@@ -44,7 +44,7 @@
 Lisp_Object Qfacep;
 Lisp_Object Qforeground, Qbackground, Qdisplay_table;
 Lisp_Object Qbackground_pixmap, Qbackground_placement, Qunderline, Qdim;
-Lisp_Object Qblinking, Qstrikethru;
+Lisp_Object Qblinking, Qstrikethru, Q_name;
 
 Lisp_Object Qinit_face_from_resources;
 Lisp_Object Qinit_frame_faces;
@@ -132,7 +132,7 @@
 
   if (print_readably)
     {
-      write_fmt_string_lisp (printcharfun, "#s(face name %S)", 1, face->name);
+      write_fmt_string_lisp (printcharfun, "#s(face :name %S)", 1, face->name);
     }
   else
     {
@@ -342,6 +342,8 @@
   int name_seen = 0;
   Lisp_Object valw = Qnil;
 
+  /* #### This syntax is very limited, given all the face properties that
+     actually exist. At least implement those in reset_face()! */
   data = Fcdr (data); /* skip over Qface */
   while (!NILP (data))
     {
@@ -350,7 +352,7 @@
       data = Fcdr (data);
       valw = Fcar (data);
       data = Fcdr (data);
-      if (EQ (keyw, Qname))
+      if (EQ (keyw, Qname) || EQ (keyw, Q_name))
 	name_seen = 1;
       else
 	ABORT ();
@@ -2170,6 +2172,8 @@
   DEFSYMBOL (Qinit_global_faces);
   DEFSYMBOL (Qinit_device_faces);
   DEFSYMBOL (Qinit_frame_faces);
+
+  DEFKEYWORD (Q_name);
 }
 
 void
@@ -2178,8 +2182,10 @@
   struct structure_type *st;
 
   st = define_structure_type (Qface, face_validate, face_instantiate);
-
+#ifdef NEED_TO_HANDLE_21_4_CODE
   define_structure_type_keyword (st, Qname, face_name_validate);
+#endif
+  define_structure_type_keyword (st, Q_name, face_name_validate);
 }
 
 void
--- a/src/general-slots.h	Sun May 30 15:16:07 2010 +0100
+++ b/src/general-slots.h	Mon May 31 16:47:44 2010 +0100
@@ -97,6 +97,7 @@
 SYMBOL (Qcurrent);
 SYMBOL (Qcursor);
 SYMBOL (Qdata);
+SYMBOL_KEYWORD (Q_data);
 SYMBOL (Qdde);
 SYMBOL (Qdead);
 SYMBOL (Qdebug);
@@ -291,6 +292,7 @@
 SYMBOL (Qtop_margin);
 SYMBOL (Qtty);
 SYMBOL (Qtype);
+SYMBOL_KEYWORD (Q_type);
 SYMBOL (Qundecided);
 SYMBOL (Qundefined);
 SYMBOL (Qunencodable);
--- a/src/glyphs.h	Sun May 30 15:16:07 2010 +0100
+++ b/src/glyphs.h	Mon May 31 16:47:44 2010 +0100
@@ -1010,7 +1010,7 @@
 #define MARK_GLYPH_CHANGED(g) (GLYPH_DIRTYP (g) = 1);
 
 extern Lisp_Object Qxpm, Qxface, Qetched_in, Qetched_out, Qbevel_in, Qbevel_out;
-extern Lisp_Object Q_data, Q_file, Q_color_symbols, Qconst_glyph_variable;
+extern Lisp_Object Q_file, Q_color_symbols, Qconst_glyph_variable;
 extern Lisp_Object Qxbm, Qedit_field, Qgroup, Qlabel, Qcombo_box, Qscrollbar;
 extern Lisp_Object Qtree_view, Qtab_control, Qprogress_gauge;
 extern Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y;
--- a/src/rangetab.c	Sun May 30 15:16:07 2010 +0100
+++ b/src/rangetab.c	Mon May 31 16:47:44 2010 +0100
@@ -104,7 +104,7 @@
   int i;
 
   if (print_readably)
-    write_fmt_string_lisp (printcharfun, "#s(range-table type %s data (",
+    write_fmt_string_lisp (printcharfun, "#s(range-table :type %s :data (",
 			   1, range_table_type_to_symbol (rt->type));
   else
     write_ascstring (printcharfun, "#<range-table ");
@@ -790,13 +790,38 @@
 {
   Lisp_Object data = Qnil, type = Qnil, rangetab;
 
-  PROPERTY_LIST_LOOP_3 (key, value, plist)
+  if (KEYWORDP (Fcar (plist)))
     {
-      if (EQ (key, Qtype)) type = value;
-      else if (EQ (key, Qdata)) data = value;
-      else
-	ABORT ();
+      PROPERTY_LIST_LOOP_3 (key, value, plist)
+	{
+	  if (EQ (key, Q_type)) type = value;
+	  else if (EQ (key, Q_data)) data = value;
+	  else if (!KEYWORDP (key))
+            signal_error
+	      (Qinvalid_read_syntax, 
+	       "can't mix keyword and non-keyword structure syntax",
+	       key);
+	  else 
+	    ABORT ();
+	}
     }
+#ifdef NEED_TO_HANDLE_21_4_CODE
+  else
+    {
+      PROPERTY_LIST_LOOP_3 (key, value, plist)
+	{
+	  if (EQ (key, Qtype)) type = value;
+	  else if (EQ (key, Qdata)) data = value;
+	  else if (KEYWORDP (key))
+            signal_error
+	      (Qinvalid_read_syntax, 
+	       "can't mix keyword and non-keyword structure syntax",
+	       key);
+	  else 
+	    ABORT ();
+	}
+    }
+#endif /* NEED_TO_HANDLE_21_4_CODE */
 
   rangetab = Fmake_range_table (type);
 
@@ -1042,6 +1067,10 @@
 
   st = define_structure_type (Qrange_table, 0, rangetab_instantiate);
 
+  define_structure_type_keyword (st, Q_data, rangetab_data_validate);
+  define_structure_type_keyword (st, Q_type, rangetab_type_validate);
+#ifdef NEED_TO_HANDLE_21_4_CODE
   define_structure_type_keyword (st, Qdata, rangetab_data_validate);
   define_structure_type_keyword (st, Qtype, rangetab_type_validate);
+#endif /* NEED_TO_HANDLE_21_4_CODE */
 }
--- a/src/symbols.c	Sun May 30 15:16:07 2010 +0100
+++ b/src/symbols.c	Mon May 31 16:47:44 2010 +0100
@@ -598,7 +598,7 @@
 !(unloading_module && UNBOUNDP(newval)) &&
 #endif
       (symbol_is_constant (sym, val)
-#ifndef NO_NEED_TO_HANDLE_21_4_CODE
+#ifdef NEED_TO_HANDLE_21_4_CODE
        || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym))
 #endif
       ))