X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Ffns.c;h=b513f4c97e8109154fa1ccbf350c2a32cbf7d062;hb=90d6a4c131eb79a8fb6b04079dd00784d913814e;hp=8cfab153865148c855e41f06b9dc7d19190b4bbf;hpb=caf1416adb403b6334ce635e58b269b6c653aa39;p=chise%2Fxemacs-chise.git- diff --git a/src/fns.c b/src/fns.c index 8cfab15..b513f4c 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1,6 +1,7 @@ /* Random utility Lisp functions. Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc. Copyright (C) 1995, 1996 Ben Wing. + Copyright (C) 2002, 2003 MORIOKA Tomohiko This file is part of XEmacs. @@ -56,6 +57,7 @@ Lisp_Object Qstring_lessp; Lisp_Object Qidentity; static int internal_old_equal (Lisp_Object, Lisp_Object, int); +Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth); static Lisp_Object mark_bit_vector (Lisp_Object obj) @@ -72,7 +74,7 @@ print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) size_t last = len; if (INTP (Vprint_length)) - last = min (len, XINT (Vprint_length)); + last = min ((EMACS_INT) len, XINT (Vprint_length)); write_c_string ("#*", printcharfun); for (i = 0; i < last; i++) { @@ -112,7 +114,7 @@ static size_t size_bit_vector (const void *lheader) { Lisp_Bit_Vector *v = (Lisp_Bit_Vector *) lheader; - return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits, + return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, unsigned long, bits, BIT_VECTOR_LONG_STORAGE (bit_vector_length (v))); } @@ -863,6 +865,15 @@ are not copied. */ (arg, vecp)) { + return safe_copy_tree (arg, vecp, 0); +} + +Lisp_Object +safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth) +{ + if (depth > 200) + signal_simple_error ("Stack overflow in copy-tree", arg); + if (CONSP (arg)) { Lisp_Object rest; @@ -872,9 +883,9 @@ are not copied. Lisp_Object elt = XCAR (rest); QUIT; if (CONSP (elt) || VECTORP (elt)) - XCAR (rest) = Fcopy_tree (elt, vecp); + XCAR (rest) = safe_copy_tree (elt, vecp, depth + 1); if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */ - XCDR (rest) = Fcopy_tree (XCDR (rest), vecp); + XCDR (rest) = safe_copy_tree (XCDR (rest), vecp, depth +1); rest = XCDR (rest); } } @@ -888,7 +899,7 @@ are not copied. Lisp_Object elt = XVECTOR_DATA (arg) [j]; QUIT; if (CONSP (elt) || VECTORP (elt)) - XVECTOR_DATA (arg) [j] = Fcopy_tree (elt, vecp); + XVECTOR_DATA (arg) [j] = safe_copy_tree (elt, vecp, depth + 1); } } return arg; @@ -3017,10 +3028,12 @@ mapcar1 (size_t leni, Lisp_Object *vals, } DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /* -Apply FUNCTION to each element of SEQUENCE, and concat the results as strings. -In between each pair of results, insert SEPARATOR. Thus, using " " as -SEPARATOR results in spaces between the values returned by FUNCTION. -SEQUENCE may be a list, a vector, a bit vector, or a string. +Apply FUNCTION to each element of SEQUENCE, and concat the results to a string. +Between each pair of results, insert SEPARATOR. + +Each result, and SEPARATOR, should be strings. Thus, using " " as SEPARATOR +results in spaces between the values returned by FUNCTION. SEQUENCE itself +may be a list, a vector, a bit vector, or a string. */ (function, sequence, separator)) { @@ -3749,6 +3762,109 @@ Characters out of the base64 alphabet are ignored. return result; } +Lisp_Object Qideographic_structure; +Lisp_Object Qkeyword_char; + +EXFUN (Fideographic_structure_to_ids, 1); + +Lisp_Object ids_format_unit (Lisp_Object ids_char); +Lisp_Object +ids_format_unit (Lisp_Object ids_char) +{ + if (CHARP (ids_char)) + return Fchar_to_string (ids_char); + else if (INTP (ids_char)) + return Fchar_to_string (Fdecode_char (Qmap_ucs, ids_char, Qnil, Qnil)); + else + { + Lisp_Object ret = Ffind_char (ids_char); + + if (CHARP (ret)) + return Fchar_to_string (ret); + else + { + ret = Fassq (Qideographic_structure, ids_char); + + if (CONSP (ret)) + return Fideographic_structure_to_ids (XCDR (ret)); + } + } + return Qnil; +} + +DEFUN ("ideographic-structure-to-ids", + Fideographic_structure_to_ids, 1, 1, 0, /* +Format ideographic-structure IDS-LIST as an IDS-string. +*/ + (ids_list)) +{ + Lisp_Object dest = Qnil; + + while (CONSP (ids_list)) + { + Lisp_Object cell = XCAR (ids_list); + + if (!NILP (Fchar_ref_p (cell))) + cell = Fplist_get (cell, Qkeyword_char, Qnil); + dest = concat2 (dest, ids_format_unit (cell)); + ids_list = XCDR (ids_list); + } + return dest; +} + +Lisp_Object simplify_char_spec (Lisp_Object char_spec); +Lisp_Object +simplify_char_spec (Lisp_Object char_spec) +{ + if (CHARP (char_spec)) + return char_spec; + else if (INTP (char_spec)) + return Fdecode_char (Qmap_ucs, char_spec, Qnil, Qnil); + else + { + Lisp_Object ret = Ffind_char (char_spec); + + if (CHARP (ret)) + return ret; + else + return char_spec; + } +} + +Lisp_Object char_ref_simplify_spec (Lisp_Object char_ref); +Lisp_Object +char_ref_simplify_spec (Lisp_Object char_ref) +{ + if (!NILP (Fchar_ref_p (char_ref))) + { + Lisp_Object ret = Fplist_get (char_ref, Qkeyword_char, Qnil); + + if (NILP (ret)) + return char_ref; + else + return Fplist_put (Fcopy_sequence (char_ref), Qkeyword_char, + simplify_char_spec (ret)); + } + else + return simplify_char_spec (char_ref); +} + +DEFUN ("char-refs-simplify-char-specs", + Fchar_refs_simplify_char_specs, 1, 1, 0, /* +Simplify char-specs in CHAR-REFS. +*/ + (char_refs)) +{ + Lisp_Object rest = char_refs; + + while (CONSP (rest)) + { + Fsetcar (rest, char_ref_simplify_spec (XCAR (rest))); + rest = XCDR (rest); + } + return char_refs; +} + Lisp_Object Qyes_or_no_p; void @@ -3758,6 +3874,8 @@ syms_of_fns (void) defsymbol (&Qstring_lessp, "string-lessp"); defsymbol (&Qidentity, "identity"); + defsymbol (&Qideographic_structure, "ideographic-structure"); + defsymbol (&Qkeyword_char, ":char"); defsymbol (&Qyes_or_no_p, "yes-or-no-p"); DEFSUBR (Fidentity); @@ -3844,6 +3962,8 @@ syms_of_fns (void) DEFSUBR (Fbase64_encode_string); DEFSUBR (Fbase64_decode_region); DEFSUBR (Fbase64_decode_string); + DEFSUBR (Fideographic_structure_to_ids); + DEFSUBR (Fchar_refs_simplify_char_specs); } void