Mercurial > hg > xemacs-beta
diff src/lread.c @ 16:0293115a14e9 r19-15b91
Import from CVS: tag r19-15b91
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:49:20 +0200 |
parents | 376386a54a3c |
children | 859a2309aef8 |
line wrap: on
line diff
--- a/src/lread.c Mon Aug 13 08:48:43 2007 +0200 +++ b/src/lread.c Mon Aug 13 08:49:20 2007 +0200 @@ -133,6 +133,8 @@ Lisp_Object Vcurrent_compiled_function_annotation; #endif +static int load_byte_code_version; + /* An array describing all known built-in structure types */ static Structure_type_dynarr *the_structure_type_dynarr; @@ -230,7 +232,16 @@ } else if (LSTREAMP (readcharfun)) { - return Lstream_get_emchar (XLSTREAM (readcharfun)); + Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun)); +#ifdef DEBUG_XEMACS /* testing Mule */ + static int testing_mule = 0; /* Change via debugger */ + if (testing_mule) { + if (c >= 0x20 && c <= 0x7E) fprintf (stderr, "%c", c); + else if (c == '\n') fprintf (stderr, "\\n\n"); + else fprintf (stderr, "\\%o ", c); + } +#endif + return c; } else if (MARKERP (readcharfun)) { @@ -269,6 +280,15 @@ else if (LSTREAMP (readcharfun)) { Lstream_unget_emchar (XLSTREAM (readcharfun), c); +#ifdef DEBUG_XEMACS /* testing Mule */ + { + static int testing_mule = 0; /* Set this using debugger */ + if (testing_mule) + fprintf (stderr, + (c >= 0x20 && c <= 0x7E) ? "UU%c" : + ((c == '\n') ? "UU\\n\n" : "UU\\%o"), c); + } +#endif } else if (MARKERP (readcharfun)) set_marker_position (readcharfun, marker_position (readcharfun) - 1); @@ -477,7 +497,10 @@ Lisp_Object handler = Qnil; Lisp_Object found = Qnil; struct gcpro gcpro1, gcpro2, gcpro3; + int reading_elc = 0; + int message_p = NILP (nomessage); #ifdef DEBUG_XEMACS + static Lisp_Object last_file_loaded; int pure_usage = 0; #endif #ifdef DOS_NT @@ -489,26 +512,29 @@ #ifdef DEBUG_XEMACS if (purify_flag && noninteractive) - pure_usage = purespace_usage (); -#endif + { + message_p = 1; + last_file_loaded = file; + pure_usage = purespace_usage (); + } +#endif /* DEBUG_XEMACS */ /* If file name is magic, call the handler. */ handler = Ffind_file_name_handler (file, Qload); if (!NILP (handler)) - { - RETURN_UNGCPRO (call5 (handler, Qload, file, no_error, nomessage, - nosuffix)); - } + RETURN_UNGCPRO (call5 (handler, Qload, file, no_error, + nomessage, nosuffix)); /* Do this after the handler to avoid the need to gcpro noerror, nomessage and nosuffix. (Below here, we care only whether they are nil or not.) */ file = Fsubstitute_in_file_name (file); + /* Avoid weird lossage with null string as arg, since it would try to load a directory as a Lisp file. Unix truly sucks. */ - if (string_length (XSTRING (file)) > 0) + if (XSTRING_LENGTH (file) > 0) { char *foundstr; int foundlen; @@ -531,8 +557,8 @@ } } - foundstr = (char *) alloca (string_length (XSTRING (found)) + 1); - strcpy (foundstr, (char *) string_data (XSTRING (found))); + foundstr = (char *) alloca (XSTRING_LENGTH (found) + 1); + strcpy (foundstr, (char *) XSTRING_DATA (found)); foundlen = strlen (foundstr); /* The omniscient JWZ thinks this is worthless, but I beg to @@ -570,45 +596,43 @@ !memcmp (".el", foundstr + foundlen - 3, 3) && /* `file' does not end in ".el" */ memcmp (".el", - string_data (XSTRING (file)) + - string_length (XSTRING (file)) - 3, + XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3, 3)) { source_only = 1; } + + if (!memcmp (".elc", foundstr + foundlen - 4, 4)) + reading_elc = 1; } #ifdef DOS_NT /* The file was opened as binary, because that's what we'll encounter most of the time. If we're loading a .el, we need to reopen it in text mode. */ - if (!memcmp (".elc", foundstr + foundlen - 4, 4)) - ; - else + if (!reading_elc) fd = open (foundstr, O_RDONLY | O_TEXT); -#endif /* not DOS_NT */ - - if (load_ignore_elc_files) - { - if (noninteractive || NILP (nomessage)) - message ("Loading %s...", string_data (XSTRING (newer))); - } - else if (!NILP (newer)) - { - message ("Loading %s... (file %s is newer)", - string_data (XSTRING (file)), - string_data (XSTRING (newer))); - nomessage = Qnil; /* we printed the first one, so print "done" too */ - } - else if (source_only) - { - message ("Loading %s... (file %s.elc does not exist)", - string_data (XSTRING (file)), - string_data (XSTRING (Ffile_name_nondirectory (file)))); - nomessage = Qnil; - } - else if (noninteractive || NILP (nomessage)) - message ("Loading %s...", string_data (XSTRING (file))); +#endif /* DOS_NT */ + +#define PRINT_LOADING_MESSAGE(done) do { \ + if (load_ignore_elc_files) \ + { \ + if (message_p) \ + message ("Loading %s..." done, XSTRING_DATA (newer)); \ + } \ + else if (!NILP (newer)) \ + message ("Loading %s..." done " (file %s is newer)", \ + XSTRING_DATA (file), \ + XSTRING_DATA (newer)); \ + else if (source_only) \ + message ("Loading %s..." done " (file %s.elc does not exist)", \ + XSTRING_DATA (file), \ + XSTRING_DATA (Ffile_name_nondirectory (file))); \ + else if (message_p) \ + message ("Loading %s..." done, XSTRING_DATA (file)); \ + } while (0) + + PRINT_LOADING_MESSAGE (""); { /* Lisp_Object's must be malloc'ed, not stack-allocated */ @@ -635,8 +659,7 @@ Vload_file_name_internal = found; Vload_file_name_internal_the_purecopy = Qnil; specbind (Qload_file_name, found); - Vload_descriptor_list - = Fcons (make_int (fd), Vload_descriptor_list); + Vload_descriptor_list = Fcons (make_int (fd), Vload_descriptor_list); Vload_force_doc_string_list = Qnil; #ifdef I18N3 record_unwind_protect (restore_file_domain, Vfile_domain); @@ -667,22 +690,19 @@ } #ifdef DEBUG_XEMACS - if (noninteractive && purify_flag) + if (purify_flag && noninteractive) { - int this_pure_usage = purespace_usage () - pure_usage; - message_append (" (%d)", this_pure_usage); + if (EQ (last_file_loaded, file)) + message_append (" (%d)", purespace_usage() - pure_usage); + else + message ("Loading %s ...done (%d)", XSTRING_DATA (file), + purespace_usage() - pure_usage); } #endif - if (noninteractive || !NILP (nomessage)) - ; - else if (!NILP (newer)) - message ("Loading %s...done (file %s is newer)", - string_data (XSTRING (file)), - string_data (XSTRING (newer))); - else - message ("Loading %s...done", string_data (XSTRING (file))); - + if (!noninteractive) + PRINT_LOADING_MESSAGE ("done"); + UNGCPRO; return Qt; } @@ -693,9 +713,9 @@ static int complete_filename_p (Lisp_Object pathname) { - REGISTER unsigned char *s = string_data (XSTRING (pathname)); + REGISTER unsigned char *s = XSTRING_DATA (pathname); return (IS_DIRECTORY_SEP (s[0]) - || (string_length (XSTRING (pathname)) > 2 + || (XSTRING_LENGTH (pathname) > 2 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])) #ifdef ALTOS || *s == '@' @@ -734,7 +754,7 @@ mode = wrong_type_argument (Qnatnump, mode); locate_file (path_list, filename, ((NILP (suffixes)) ? "" : - (char *) (string_data (XSTRING (suffixes)))), + (char *) (XSTRING_DATA (suffixes))), &tp, (NILP (mode) ? R_OK : XINT (mode))); return tp; } @@ -745,7 +765,7 @@ locate_file_refresh_hashing (Lisp_Object str) { Lisp_Object hash = - make_directory_hash_table ((char *) string_data (XSTRING (str))); + make_directory_hash_table ((char *) XSTRING_DATA (str)); Fput (str, Qlocate_file_hash_table, hash); return hash; } @@ -802,8 +822,7 @@ } /* Calculate maximum size of any filename made from this path element/specified file name and any possible suffix. */ - want_size = strlen (suffix) + - string_length (XSTRING (filename)) + 1; + want_size = strlen (suffix) + XSTRING_LENGTH (filename) + 1; if (fn_size < want_size) fn = (char *) alloca (fn_size = 100 + want_size); @@ -816,9 +835,9 @@ int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix)); /* Concatenate path element/specified name with the suffix. */ - strncpy (fn, (char *) string_data (XSTRING (filename)), - string_length (XSTRING (filename))); - fn[string_length (XSTRING (filename))] = 0; + strncpy (fn, (char *) XSTRING_DATA (filename), + XSTRING_LENGTH (filename)); + fn[XSTRING_LENGTH (filename)] = 0; if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */ strncat (fn, nsuffix, lsuffix); @@ -910,7 +929,7 @@ /* Calculate maximum size of any filename made from this path element/specified file name and any possible suffix. */ - want_size = strlen (suffix) + string_length (XSTRING (str)) + 1; + want_size = strlen (suffix) + XSTRING_LENGTH (str) + 1; if (fn_size < want_size) fn = (char *) alloca (fn_size = 100 + want_size); @@ -922,9 +941,8 @@ int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix)); /* Concatenate path element/specified name with the suffix. */ - strncpy (fn, (char *) string_data (XSTRING (str)), - string_length (XSTRING (str))); - fn[string_length (XSTRING (str))] = 0; + strncpy (fn, (char *) XSTRING_DATA (str), XSTRING_LENGTH (str)); + fn[XSTRING_LENGTH (str)] = 0; if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */ strncat (fn, nsuffix, lsuffix); @@ -1408,7 +1426,7 @@ tem = (Fcons (tem, make_int (bytecount_to_charcount - (string_data (XSTRING (string)), + (XSTRING_DATA (string), startval + Lstream_byte_count (XLSTREAM (lispstream)))))); Lstream_delete (XLSTREAM (lispstream)); UNGCPRO; @@ -1568,6 +1586,7 @@ return i; } + default: return c; } @@ -2627,10 +2646,10 @@ { if (NILP (Vdoc_file_name)) /* We have not yet called Snarf-documentation, so - assume this file is described in the DOC-MM.NN - file and Snarf-documentation will fill in the - right value later. For now, replace the whole - list with 0. */ + assume this file is described in the DOC file + and Snarf-documentation will fill in the right + value later. For now, replace the whole list + with 0. */ XCAR (holding_cons) = Qzero; else /* We have already called Snarf-documentation, so @@ -2798,9 +2817,9 @@ if (!NILP (dirfile)) { dirfile = Fdirectory_file_name (dirfile); - if (access ((char *) string_data (XSTRING (dirfile)), 0) < 0) + if (access ((char *) XSTRING_DATA (dirfile), 0) < 0) stdout_out ("Warning: lisp library (%s) does not exist.\n", - string_data (XSTRING (Fcar (normal_path)))); + XSTRING_DATA (Fcar (normal_path))); } } }