[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] emacs/src ChangeLog lread.c print.c
From: |
Teodor Zlatanov |
Subject: |
[Emacs-diffs] emacs/src ChangeLog lread.c print.c |
Date: |
Wed, 05 Aug 2009 09:19:23 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Teodor Zlatanov <tzz> 09/08/05 09:19:23
Modified files:
src : ChangeLog lread.c print.c
Log message:
* lread.c (read1, syms_of_lread): Read hashtables back from the
readable format.
* print.c (print_preprocess, print_object): Print hashtables fully
and readably.
(syms_of_print): Provide 'hashtable-print-readable.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/src/ChangeLog?cvsroot=emacs&r1=1.7674&r2=1.7675
http://cvs.savannah.gnu.org/viewcvs/emacs/src/lread.c?cvsroot=emacs&r1=1.409&r2=1.410
http://cvs.savannah.gnu.org/viewcvs/emacs/src/print.c?cvsroot=emacs&r1=1.256&r2=1.257
Patches:
Index: ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/src/ChangeLog,v
retrieving revision 1.7674
retrieving revision 1.7675
diff -u -b -r1.7674 -r1.7675
--- ChangeLog 2 Aug 2009 15:37:07 -0000 1.7674
+++ ChangeLog 5 Aug 2009 09:19:21 -0000 1.7675
@@ -1,3 +1,12 @@
+2009-08-05 Teodor Zlatanov <address@hidden>
+
+ * lread.c (read1, syms_of_lread): Read hashtables back from the
+ readable format.
+
+ * print.c (print_preprocess, print_object): Print hashtables fully
+ and readably.
+ (syms_of_print): Provide 'hashtable-print-readable.
+
2009-08-02 Adrian Robert <address@hidden>
* nsfont.m (ns_descriptor_to_entity): Handle case when descriptor has
Index: lread.c
===================================================================
RCS file: /sources/emacs/emacs/src/lread.c,v
retrieving revision 1.409
retrieving revision 1.410
diff -u -b -r1.409 -r1.410
--- lread.c 25 Jul 2009 08:50:17 -0000 1.409
+++ lread.c 5 Aug 2009 09:19:22 -0000 1.410
@@ -80,6 +80,14 @@
extern int errno;
#endif
+/* hash table read constants */
+Lisp_Object Qhash_table, Qdata;
+Lisp_Object Qtest, Qsize;
+Lisp_Object Qweakness;
+Lisp_Object Qrehash_size;
+Lisp_Object Qrehash_threshold;
+extern Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold,
QCweakness;
+
Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input,
Vafter_load_alist;
Lisp_Object Qascii_character, Qload, Qload_file_name;
@@ -2346,6 +2354,78 @@
case '#':
c = READCHAR;
+ if (c == 's')
+ {
+ c = READCHAR;
+ if (c == '(')
+ {
+ /* Accept extended format for hashtables (extensible to
+ other types), e.g.
+ #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
+ Lisp_Object tmp = read_list (0, readcharfun);
+ Lisp_Object head = CAR_SAFE (tmp);
+ Lisp_Object data = Qnil;
+ Lisp_Object val = Qnil;
+ /* The size is 2 * number of allowed keywords to
+ make-hash-table. */
+ Lisp_Object params[10];
+ Lisp_Object ht;
+ Lisp_Object key = Qnil;
+ int param_count = 0;
+ int i;
+
+ if (!EQ (head, Qhash_table))
+ error ("Invalid extended read marker at head of #s list "
+ "(only hash-table allowed)");
+
+ tmp = CDR_SAFE (tmp);
+
+ /* This is repetitive but fast and simple. */
+ params[param_count] = QCsize;
+ params[param_count+1] = Fplist_get (tmp, Qsize);
+ if (!NILP (params[param_count+1]))
+ param_count+=2;
+
+ params[param_count] = QCtest;
+ params[param_count+1] = Fplist_get (tmp, Qtest);
+ if (!NILP (params[param_count+1]))
+ param_count+=2;
+
+ params[param_count] = QCweakness;
+ params[param_count+1] = Fplist_get (tmp, Qweakness);
+ if (!NILP (params[param_count+1]))
+ param_count+=2;
+
+ params[param_count] = QCrehash_size;
+ params[param_count+1] = Fplist_get (tmp, Qrehash_size);
+ if (!NILP (params[param_count+1]))
+ param_count+=2;
+
+ params[param_count] = QCrehash_threshold;
+ params[param_count+1] = Fplist_get (tmp, Qrehash_threshold);
+ if (!NILP (params[param_count+1]))
+ param_count+=2;
+
+ /* This is the hashtable data. */
+ data = Fplist_get (tmp, Qdata);
+
+ /* Now use params to make a new hashtable and fill it. */
+ ht = Fmake_hash_table (param_count, params);
+
+ while (CONSP (data))
+ {
+ key = XCAR (data);
+ data = XCDR (data);
+ if (!CONSP (data))
+ error ("Odd number of elements in hashtable data");
+ val = XCAR (data);
+ data = XCDR (data);
+ Fputhash (key, val, ht);
+ }
+
+ return ht;
+ }
+ }
if (c == '^')
{
c = READCHAR;
@@ -4448,6 +4528,21 @@
Vloads_in_progress = Qnil;
staticpro (&Vloads_in_progress);
+
+ Qhash_table = intern ("hash-table");
+ staticpro (&Qhash_table);
+ Qdata = intern ("data");
+ staticpro (&Qdata);
+ Qtest = intern ("test");
+ staticpro (&Qtest);
+ Qsize = intern ("size");
+ staticpro (&Qsize);
+ Qweakness = intern ("weakness");
+ staticpro (&Qweakness);
+ Qrehash_size = intern ("rehash-size");
+ staticpro (&Qrehash_size);
+ Qrehash_threshold = intern ("rehash-threshold");
+ staticpro (&Qrehash_threshold);
}
/* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
Index: print.c
===================================================================
RCS file: /sources/emacs/emacs/src/print.c,v
retrieving revision 1.256
retrieving revision 1.257
diff -u -b -r1.256 -r1.257
--- print.c 3 Apr 2009 06:23:49 -0000 1.256
+++ print.c 5 Aug 2009 09:19:22 -0000 1.257
@@ -1341,6 +1341,7 @@
loop:
if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
|| COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
+ || HASH_TABLE_P (obj)
|| (! NILP (Vprint_gensym)
&& SYMBOLP (obj)
&& !SYMBOL_INTERNED_P (obj)))
@@ -1536,6 +1537,7 @@
/* Detect circularities and truncate them. */
if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
|| COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
+ || HASH_TABLE_P (obj)
|| (! NILP (Vprint_gensym)
&& SYMBOLP (obj)
&& !SYMBOL_INTERNED_P (obj)))
@@ -2031,6 +2033,7 @@
else if (HASH_TABLE_P (obj))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
+#if 0
strout ("#<hash-table", -1, -1, printcharfun, 0);
if (SYMBOLP (h->test))
{
@@ -2047,6 +2050,67 @@
sprintf (buf, " 0x%lx", (unsigned long) h);
strout (buf, -1, -1, printcharfun, 0);
PRINTCHAR ('>');
+#endif
+ /* Implement a readable output, e.g.:
+ #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
+ /* Always print the size. */
+ sprintf (buf, "#s(hash-table size %ld",
+ (long) XVECTOR (h->next)->size);
+ strout (buf, -1, -1, printcharfun, 0);
+
+ if (!NILP (h->test))
+ {
+ strout (" test ", -1, -1, printcharfun, 0);
+ print_object (h->test, printcharfun, 0);
+ }
+
+ if (!NILP (h->weak))
+ {
+ strout (" weakness ", -1, -1, printcharfun, 0);
+ print_object (h->weak, printcharfun, 0);
+ }
+
+ if (!NILP (h->rehash_size))
+ {
+ strout (" rehash-size ", -1, -1, printcharfun, 0);
+ print_object (h->rehash_size, printcharfun, 0);
+ }
+
+ if (!NILP (h->rehash_threshold))
+ {
+ strout (" rehash-threshold ", -1, -1, printcharfun, 0);
+ print_object (h->rehash_threshold, printcharfun, 0);
+ }
+
+ strout (" data ", -1, -1, printcharfun, 0);
+
+ /* Print the data here as a plist. */
+ int i;
+
+ int real_size = HASH_TABLE_SIZE (h);
+ int size = real_size;
+
+ /* Don't print more elements than the specified maximum. */
+ if (NATNUMP (Vprint_length)
+ && XFASTINT (Vprint_length) < size)
+ size = XFASTINT (Vprint_length);
+
+ PRINTCHAR ('(');
+ for (i = 0; i < size; i++)
+ if (!NILP (HASH_HASH (h, i)))
+ {
+ if (i) PRINTCHAR (' ');
+ print_object (HASH_KEY (h, i), printcharfun, 0);
+ PRINTCHAR (' ');
+ print_object (HASH_VALUE (h, i), printcharfun, 0);
+ }
+
+ if (size < real_size)
+ strout (" ...", 4, 4, printcharfun, 0);
+
+ PRINTCHAR (')');
+ PRINTCHAR (')');
+
}
else if (BUFFERP (obj))
{
@@ -2354,6 +2418,8 @@
Qfloat_output_format = intern ("float-output-format");
staticpro (&Qfloat_output_format);
+ Fprovide (intern ("hashtable-print-readable"), Qnil);
+
DEFVAR_LISP ("print-length", &Vprint_length,
doc: /* Maximum length of list to print before abbreviating.
A value of nil means no limit. See also `eval-expression-print-length'. */);
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] emacs/src ChangeLog lread.c print.c,
Teodor Zlatanov <=