* 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.
This commit is contained in:
Teodor Zlatanov
parent
74edaf1f3e
commit
f19a0f5b11
3 changed files with 170 additions and 0 deletions
|
|
@ -1,3 +1,12 @@
|
|||
2009-08-05 Teodor Zlatanov <tzz@lifelogs.com>
|
||||
|
||||
* 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 <Adrian.B.Robert@gmail.com>
|
||||
|
||||
* nsfont.m (ns_descriptor_to_entity): Handle case when descriptor has
|
||||
|
|
|
|||
95
src/lread.c
95
src/lread.c
|
|
@ -80,6 +80,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
|||
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 @@ read1 (readcharfun, pch, first_in_list)
|
|||
|
||||
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 @@ to load. See also `load-dangerous-libraries'. */);
|
|||
|
||||
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
|
||||
|
|
|
|||
66
src/print.c
66
src/print.c
|
|
@ -1341,6 +1341,7 @@ print_preprocess (obj)
|
|||
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 @@ print_object (obj, printcharfun, escapeflag)
|
|||
/* 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 @@ print_object (obj, printcharfun, escapeflag)
|
|||
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 @@ print_object (obj, printcharfun, escapeflag)
|
|||
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 @@ that represents the number without losing information. */);
|
|||
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'. */);
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue