Mercurial > hg > xemacs-beta
changeset 930:eaedf30d9d76
[xemacs-hg @ 2002-07-23 08:34:59 by youngs]
2002-07-15 Jerry James <james@xemacs.org>
* make-docfile.c: Change whitespace and organization to reduce the
size of the diff against FSF Emacs sources and synch to Emacs 21.2.
Remove unused DO_REALLOC.
Mark XEmacs changes and additions more clearly.
Reintroduce previously deleted Emacs code inside #if 0 ... #endif.
* make-docfile.c (next_extra_elc): Replace goto with do-while.
* make-docfile.c (main): Put XEmacs-only args in one place.
* make-docfile.c (write_c_args): Change buff to buf to match
Emacs. Replace pointer arithmetic with simpler array syntax.
* make-docfile.c (scan_c_file): Note that DEFSIMPLE and DEFPRED no
longer exist. Correct the "name too long" test (off by one).
Die with message if a DEFUN has no docstring instead of hanging.
* make-docfile.c (scan_lisp_file): Introduce while loops used in
Emacs sources to skip consecutive blank lines.
2002-07-21 John Paul Wallington <jpw@xemacs.org>
* process.el (substitute-env-vars): New function; sync with
GNU Emacs 21.1.50.
(setenv): Add optional arg SUBSTITUTE-ENV-VARS; sync with
GNU Emacs 21.1.50.
2002-07-20 Mike Sperber <mike@xemacs.org>
* eval.c (run_post_gc_hook): Use more correct flags when running
post-gc-hook.
2002-07-20 Mike Sperber <mike@xemacs.org>
* process-unix.c (child_setup): Don't try to close file
descriptors for chid process once again---it's already being done
in close_process_descs.
(unix_create_process): Call begin_dont_check_for_quit to inhibit
unwanted interaction (and thus breaking of X event synchronicity)
in the child.
2002-07-15 Jerry James <james@xemacs.org>
* lisp.h: Make Qdll_error visible globally.
* symbols.c (check_sane_subr): Revert 2002-06-26 change.
Check only if !initialized.
* symbols.c (check_module_subr): Add parameter. Duplicate
check_sane_subr checks, but signal an error instead of asserting.
* symbols.c (defsubr): Use check_module_subr parameter.
* symbols.c (defsubr_macro): Ditto.
| author | youngs |
|---|---|
| date | Tue, 23 Jul 2002 08:35:11 +0000 |
| parents | 0c272be3414c |
| children | 3508e2f71814 |
| files | lib-src/ChangeLog lib-src/make-docfile.c lisp/ChangeLog lisp/process.el src/ChangeLog src/eval.c src/lisp.h src/process-unix.c src/symbols.c |
| diffstat | 9 files changed, 388 insertions(+), 195 deletions(-) [+] |
line wrap: on
line diff
--- a/lib-src/ChangeLog Sun Jul 21 04:51:07 2002 +0000 +++ b/lib-src/ChangeLog Tue Jul 23 08:35:11 2002 +0000 @@ -1,3 +1,20 @@ +2002-07-15 Jerry James <james@xemacs.org> + + * make-docfile.c: Change whitespace and organization to reduce the + size of the diff against FSF Emacs sources and synch to Emacs 21.2. + Remove unused DO_REALLOC. + Mark XEmacs changes and additions more clearly. + Reintroduce previously deleted Emacs code inside #if 0 ... #endif. + * make-docfile.c (next_extra_elc): Replace goto with do-while. + * make-docfile.c (main): Put XEmacs-only args in one place. + * make-docfile.c (write_c_args): Change buff to buf to match + Emacs. Replace pointer arithmetic with simpler array syntax. + * make-docfile.c (scan_c_file): Note that DEFSIMPLE and DEFPRED no + longer exist. Correct the "name too long" test (off by one). + Die with message if a DEFUN has no docstring instead of hanging. + * make-docfile.c (scan_lisp_file): Introduce while loops used in + Emacs sources to skip consecutive blank lines. + 2002-07-14 Adrian Aichner <adrian@xemacs.org> * etags.c: It's XEmacs, not Xemacs.
--- a/lib-src/make-docfile.c Sun Jul 21 04:51:07 2002 +0000 +++ b/lib-src/make-docfile.c Tue Jul 23 08:35:11 2002 +0000 @@ -1,76 +1,60 @@ /* Generate doc-string file for XEmacs from source files. - Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1985, 86, 92, 93, 94, 97, 1999, 2000, 2001 + Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1998, 1999 J. Kean Johnston. Copyright (C) 2001, 2002 Ben Wing. - - This file is part of XEmacs. - - XEmacs is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by the - Free Software Foundation; either version 2, or (at your option) any - later version. - - XEmacs is distributed in the hope that it will be useful, but WITHOUT - ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or - FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License - for more details. - - You should have received a copy of the GNU General Public License - along with XEmacs; see the file COPYING. If not, write to - the Free Software Foundation, Inc., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. -/* Synched up with: FSF 19.30. */ +XEmacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: FSF 21.2. */ /* The arguments given to this program are all the C and Lisp source files - of XEmacs. .elc and .el and .c files are allowed. - A .o or .obj file can also be specified; the .c file it was made from is - used. This helps the makefile pass the correct list of files. - - The results, which go to standard output or to a file - specified with -a or -o (-a to append, -o to start from nothing), - are entries containing function or variable names and their documentation. - Each entry starts with a ^_ character. - Then comes F for a function or V for a variable. - Then comes the function or variable name, terminated with a newline. - Then comes the documentation for that function or variable. - - Added 19.15/20.1: `-i site-packages' allow installer to dump extra packages - without modifying Makefiles, etc. + of XEmacs. .elc and .el and .c files are allowed. + A .o or .obj file can also be specified; the .c file it was made from is used. + This helps the makefile pass the correct list of files. + + The results, which go to standard output or to a file + specified with -a or -o (-a to append, -o to start from nothing), + are entries containing function or variable names and their documentation. + Each entry starts with a ^_ character. + Then comes F for a function or V for a variable. + Then comes the function or variable name, terminated with a newline. + Then comes the documentation for that function or variable. + + Added 19.15/20.1: `-i site-packages' allow installer to dump extra packages + without modifying Makefiles, etc. */ #include <config.h> +#include <sysfile.h> #include <stdio.h> #include <stdlib.h> #include <string.h> #include <ctype.h> -#include "../src/sysfile.h" - -/* From src/lisp.h */ -#define DO_REALLOC(basevar, sizevar, needed_size, type) do { \ - size_t do_realloc_needed_size = (needed_size); \ - if ((sizevar) < do_realloc_needed_size) \ - { \ - if ((sizevar) < 32) \ - (sizevar) = 32; \ - while ((sizevar) < do_realloc_needed_size) \ - (sizevar) *= 2; \ - XREALLOC_ARRAY (basevar, type, (sizevar)); \ - } \ -} while (0) - -/* Stdio stream for output to the DOC file. */ -static FILE *outfile; - -enum -{ - el_file, - elc_file, - c_file -} Current_file_type; +/* XEmacs addition */ +#define C_IDENTIFIER_CHAR_P(c) \ + (('A' <= c && c <= 'Z') || \ + ('a' <= c && c <= 'z') || \ + ('0' <= c && c <= '9') || \ + (c == '_')) static int scan_file (const char *filename); static int read_c_string (FILE *, int, int); @@ -81,16 +65,21 @@ static void read_lisp_symbol (FILE *, char *); static int scan_lisp_file (const char *filename, const char *mode); -#define C_IDENTIFIER_CHAR_P(c) \ - (('A' <= c && c <= 'Z') || \ - ('a' <= c && c <= 'z') || \ - ('0' <= c && c <= '9') || \ - (c == '_')) +/* Stdio stream for output to the DOC file. */ +static FILE *outfile; + +/* XEmacs addition */ +enum +{ + el_file, + elc_file, + c_file +} Current_file_type; /* Name this program was invoked with. */ char *progname; -/* Set to 1 if this was invoked by ellcc */ +/* XEmacs addition: set to 1 if this was invoked by ellcc */ int ellcc = 0; /* Print error message. `s1' is printf control string, `s2' is arg for it. */ @@ -123,6 +112,7 @@ return result; } +/* XEmacs addition */ static char * next_extra_elc (char *extra_elcs) { @@ -143,19 +133,18 @@ fgets (line_buf, BUFSIZ, fp); } - again: - if (!fgets (line_buf, BUFSIZ, fp)) + do { - fclose (fp); - fp = NULL; - return NULL; - } - line_buf[0] = '\0'; - if (strlen (p) <= 2 || strlen (p) >= (BUFSIZ - 5)) - { + if (!fgets (line_buf, BUFSIZ, fp)) + { + fclose (fp); + fp = NULL; + return NULL; + } + line_buf[0] = '\0'; /* reject too short or too long lines */ - goto again; - } + } while (strlen (p) <= 2 || strlen (p) >= (BUFSIZ - 5)); + p[strlen (p) - 2] = '\0'; strcat (p, ".elc"); @@ -169,7 +158,7 @@ int i; int err_count = 0; int first_infile; - char *extra_elcs = NULL; + char *extra_elcs = NULL; /* XEmacs addition */ progname = argv[0]; @@ -193,18 +182,19 @@ outfile = fopen (argv[i + 1], APPEND_BINARY); i += 2; } + if (argc > i + 1 && !strcmp (argv[i], "-d")) + { + chdir (argv[i + 1]); + i += 2; + } + + /* Additional command line arguments for XEmacs */ if (argc > i + 1 && !strcmp (argv[i], "-E")) { outfile = fopen (argv[i + 1], APPEND_BINARY); i += 2; ellcc = 1; } - if (argc > i + 1 && !strcmp (argv[i], "-d")) - { - chdir (argv[i + 1]); - i += 2; - } - if (argc > (i + 1) && !strcmp (argv[i], "-i")) { extra_elcs = argv[i + 1]; @@ -214,13 +204,15 @@ if (outfile == 0) fatal ("No output file specified", ""); + /* XEmacs addition */ if (ellcc) fprintf (outfile, "{\n"); first_infile = i; - for (; i < argc; i++) { + /* XEmacs addition: the "if" clause is new; the "else" clause is the + original FSF Emacs code */ if (argv[i][0] == '@') { /* Allow a file containing files to process, for use w/MS Windows @@ -240,17 +232,16 @@ else { int j; - /* Don't process one file twice. */ for (j = first_infile; j < i; j++) if (! strcmp (argv[i], argv[j])) break; if (j == i) - /* err_count seems to be {mis,un}used */ err_count += scan_file (argv[i]); } } + /* XEmacs addition */ if (extra_elcs) { char *p; @@ -262,6 +253,8 @@ putc ('\n', outfile); if (ellcc) fprintf (outfile, "}\n\n"); + /* End XEmacs addition */ + #ifndef VMS exit (err_count > 0); #endif /* VMS */ @@ -275,6 +268,8 @@ scan_file (const char *filename) { int len = strlen (filename); + + /* XEmacs change: test ellcc and set Current_file_type in each case */ if (ellcc == 0 && len > 4 && !strcmp (filename + len - 4, ".elc")) { Current_file_type = elc_file; @@ -291,7 +286,8 @@ return scan_c_file (filename, READ_TEXT); } } - + +/* XEmacs addition: ISO 2022 handling */ static int getc_skipping_iso2022 (FILE *file) { @@ -380,7 +376,7 @@ char buf[128]; /* Skip a C string from INFILE, - and return the character that follows the closing ". + and return the character that follows the closing ". If printflag is positive, output string contents to outfile. If it is negative, store contents in buf. Convert escape sequences \n and \t to newline and tab; @@ -392,13 +388,14 @@ { register int prevc = 0, c = 0; char *p = buf; - int start = -1; + int start = -1; /* XEmacs addition */ MDGET; while (c != EOF) { while ((c_docstring || c != '"' || non_ascii_p) && c != EOF) { + /* XEmacs addition: the first two "if" clauses are new */ if (c == '*' && !non_ascii_p) { int cc = getc (infile); @@ -432,6 +429,7 @@ else if (printflag < 0) *p++ = '\n'; } + /* End XEmacs addition */ if (c == '\\' && !non_ascii_p) { @@ -447,6 +445,9 @@ if (c == 't') c = '\t'; } + + /* XEmacs change: the "if" clause is new; the "else" clause is + mostly the original FSF Emacs code */ if (c == '\n') start = 1; else @@ -463,7 +464,7 @@ } MDGET; } - /* look for continuation of string */ + /* XEmacs change: look for continuation of string */ if (Current_file_type == c_file) { do @@ -483,10 +484,10 @@ } MDGET; } - + if (printflag < 0) *p = 0; - + return c; } @@ -494,8 +495,7 @@ MINARGS and MAXARGS are the minimum and maximum number of arguments. */ static void -write_c_args (FILE *out, const char *func, char *buff, int minargs, - int maxargs) +write_c_args (FILE *out, const char *func, char *buf, int minargs, int maxargs) { register char *p; int in_ident = 0; @@ -514,20 +514,20 @@ fprintf (out, "arguments: ("); #endif - if (*buff == '(') - ++buff; + if (*buf == '(') + ++buf; - for (p = buff; *p; p++) + for (p = buf; *p; p++) { char c = *p; int ident_start = 0; - /* Add support for ANSI prototypes. Hop over + /* XEmacs addition: add support for ANSI prototypes. Hop over "Lisp_Object" string (the only C type allowed in DEFUNs) */ static char lo[] = "Lisp_Object"; if ((C_IDENTIFIER_CHAR_P (c) != in_ident) && !in_ident && (strncmp (p, lo, sizeof (lo) - 1) == 0) && - isspace ((unsigned char) (* (p + sizeof (lo) - 1)))) + isspace ((unsigned char) p[sizeof (lo) - 1])) { p += (sizeof (lo) - 1); while (isspace ((unsigned char) (*p))) @@ -559,11 +559,29 @@ } /* Print the C argument list as it would appear in lisp: - print underscores as hyphens, and print commas as spaces. - Collapse adjacent spaces into one. */ - if (c == '_') c = '-'; - if (c == ',') c = ' '; + print underscores as hyphens, and print commas and newlines + as spaces. Collapse adjacent spaces into one. */ + if (c == '_') + c = '-'; + else if (c == ',' || c == '\n') + c = ' '; +#if 0 + /* In C code, `default' is a reserved word, so we spell it + `defalt'; unmangle that here. */ + if (ident_start + && strncmp (p, "defalt", 6) == 0 + && ! (('A' <= p[6] && p[6] <= 'Z') + || ('a' <= p[6] && p[6] <= 'z') + || ('0' <= p[6] && p[6] <= '9') + || p[6] == '_')) + { + fprintf (out, "DEFAULT"); + p += 5; + in_ident = 0; + just_spaced = 0; + } +#endif /* If the C argument name ends with `_', change it to ' ', to allow use of C reserved words or global symbols as Lisp args. */ if (c == '-' && ! C_IDENTIFIER_CHAR_P (p[1])) @@ -571,7 +589,7 @@ in_ident = 0; just_spaced = 0; } - else if (c != ' ' || ! just_spaced) + else if (c != ' ' || !just_spaced) { if (c >= 'a' && c <= 'z') /* Upcase the letter. */ @@ -584,14 +602,16 @@ need_space = 0; #endif } + /* XEmacs addition */ if (!ellcc) - putc ('\n', out); /* XEmacs addition */ + putc ('\n', out); } /* Read through a c file. If a .o or .obj file is named, the corresponding .c file is read instead. Looks for DEFUN constructs such as are defined in ../src/lisp.h. - Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED. */ + Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED ... + which don't exist anymore! */ static int scan_c_file (const char *filename, const char *mode) @@ -606,14 +626,15 @@ int l = strlen (filename); char f[PATH_MAX]; - if (l > (int) sizeof (f)) + /* XEmacs change: different method for checking filename extension */ + if (l > PATH_MAX - 1) { #ifdef ENAMETOOLONG errno = ENAMETOOLONG; #else errno = EINVAL; #endif - return (0); + return 0; } strcpy (f, filename); @@ -630,6 +651,11 @@ return 0; } +#if 0 + /* Reset extension to be able to detect duplicate files. */ + filename[strlen (filename) - 1] = extension; +#endif + c = '\n'; while (!feof (infile)) { @@ -685,7 +711,7 @@ c = getc (infile); defunflag = (c == 'U'); defvarflag = 0; - c = getc (infile); + c = getc (infile); /* XEmacs addition */ } else continue; @@ -707,7 +733,7 @@ commas = 2; else if (defvarflag) commas = 1; - else /* For DEFSIMPLE and DEFPRED */ + else /* For DEFSIMPLE and DEFPRED ... which now don't exist! */ commas = 2; while (commas) @@ -719,14 +745,13 @@ { do c = getc (infile); - while (c == ' ' || c == '\n' || c == '\t') - ; + while (c == ' ' || c == '\n' || c == '\t'); if (c < 0) goto eof; ungetc (c, infile); if (commas == 2) /* pick up minargs */ fscanf (infile, "%d", &minargs); - else /* pick up maxargs */ + else /* pick up maxargs */ if (c == 'M' || c == 'U') /* MANY || UNEVALLED */ maxargs = -1; else @@ -741,12 +766,15 @@ c = getc (infile); if (c == '"') c = read_c_string (infile, 0, 0); + /* XEmacs change */ if (defunflag | defvarflag) { while (c != '/') { if (c < 0) goto eof; + if (defunflag && c == '(') + fatal ("Missing doc string for DEFUN %s\n", buf); c = getc (infile); } c = getc (infile); @@ -763,13 +791,17 @@ } c = getc (infile); } + /* End XEmacs change */ while (c == ' ' || c == '\n' || c == '\t') c = getc (infile); + /* XEmacs addition */ if (defunflag | defvarflag) ungetc (c, infile); + /* End XEmacs addition */ if (defunflag || defvarflag || c == '"') { + /* XEmacs change: the original code is in the "else" clause */ if (ellcc) fprintf (outfile, " CDOC%s(\"%s\", \"\\\n", defvarflag ? "SYM" : "SUBR", buf); @@ -779,7 +811,7 @@ putc (defvarflag ? 'V' : 'F', outfile); fprintf (outfile, "%s\n", buf); } - c = read_c_string (infile, 1, (defunflag || defvarflag)); + c = read_c_string (infile, 1, defunflag || defvarflag); /* If this is a defun, find the arguments and print them. If this function takes MANY or UNEVALLED args, then the C source @@ -830,29 +862,34 @@ } /* Read a file of Lisp code, compiled or interpreted. - Looks for - (defun NAME ARGS DOCSTRING ...) - (defmacro NAME ARGS DOCSTRING ...) - (autoload (quote NAME) FILE DOCSTRING ...) - (defvar NAME VALUE DOCSTRING) - (defconst NAME VALUE DOCSTRING) - (fset (quote NAME) (make-byte-code ... DOCSTRING ...)) - (fset (quote NAME) #[... DOCSTRING ...]) - (defalias (quote NAME) #[... DOCSTRING ...]) - starting in column zero. - (quote NAME) may appear as 'NAME as well. + Looks for + (defun NAME ARGS DOCSTRING ...) + (defmacro NAME ARGS DOCSTRING ...) + (defsubst NAME ARGS DOCSTRING ...) + (autoload (quote NAME) FILE DOCSTRING ...) + (defvar NAME VALUE DOCSTRING) + (defconst NAME VALUE DOCSTRING) + (fset (quote NAME) (make-byte-code ... DOCSTRING ...)) + (fset (quote NAME) #[... DOCSTRING ...]) + (defalias (quote NAME) #[... DOCSTRING ...]) + (custom-declare-variable (quote NAME) VALUE DOCSTRING ...) + starting in column zero. + (quote NAME) may appear as 'NAME as well. We also look for #@LENGTH CONTENTS^_ at the beginning of the line. When we find that, we save it for the following defining-form, and we use that instead of reading a doc string within that defining-form. - For defun, defmacro, and autoload, we know how to skip over the arglist. - For defvar, defconst, and fset we skip to the docstring with a kludgy + For defvar, defconst, and fset we skip to the docstring with a kludgy formatting convention: all docstrings must appear on the same line as the - initial open-paren (the one in column zero) and must contain a backslash - and a double-quote immediately after the initial double-quote. No newlines + initial open-paren (the one in column zero) and must contain a backslash + and a newline immediately after the initial double-quote. No newlines must appear between the beginning of the form and the first double-quote. - The only source file that must follow this convention is loaddefs.el; aside + For defun, defmacro, and autoload, we know how to skip over the + arglist, but the doc string must still have a backslash and newline + immediately after the double quote. + The only source files that must follow this convention are preloaded + uncompiled ones like loaddefs.el and bindings.el; aside from that, it is always the .elc file that we look at, and they are no problem because byte-compiler output follows this convention. The NAME and DOCSTRING are output. @@ -909,7 +946,7 @@ if (infile == NULL) { perror (filename); - return 0; /* No error */ + return 0; /* No error */ } c = '\n'; @@ -918,12 +955,15 @@ char buffer[BUFSIZ]; char type; + /* If not at end of line, skip till we get to one. */ if (c != '\n') { c = getc_skipping_iso2022 (infile); continue; } - c = getc_skipping_iso2022 (infile); + /* Skip the line break. */ + while (c == '\n') + c = getc_skipping_iso2022 (infile); /* Detect a dynamic doc string and save it for the next expression. */ if (c == '#') { @@ -956,14 +996,12 @@ That is needed in the .elc file but it is redundant in DOC. So get rid of it here. */ saved_string[length - 1] = 0; - /* Skip the newline. */ - c = getc_skipping_iso2022 (infile); + /* Skip the line break. */ + while (c == '\n') + c = getc_skipping_iso2022 (infile); + /* Skip the following line. */ while (c != '\n') - { - c = getc_skipping_iso2022 (infile); - if (c < 0) - continue; - } + c = getc_skipping_iso2022 (infile); } continue; } @@ -973,8 +1011,9 @@ read_lisp_symbol (infile, buffer); - if (! strcmp (buffer, "defun") || - ! strcmp (buffer, "defmacro")) + if (! strcmp (buffer, "defun") + || ! strcmp (buffer, "defmacro") + || ! strcmp (buffer, "defsubst")) { type = 'F'; read_lisp_symbol (infile, buffer); @@ -982,7 +1021,7 @@ /* Skip the arguments: either "nil" or a list in parens */ c = getc_skipping_iso2022 (infile); - if (c == 'n') /* nil */ + if (c == 'n') /* nil */ { if ((c = getc_skipping_iso2022 (infile)) != 'i' || (c = getc_skipping_iso2022 (infile)) != 'l') @@ -1009,7 +1048,7 @@ /* If the next three characters aren't `dquote bslash newline' then we're not reading a docstring. - */ + */ if ((c = getc_skipping_iso2022 (infile)) != '"' || (c = getc_skipping_iso2022 (infile)) != '\\' || (c = getc_skipping_iso2022 (infile)) != '\n') @@ -1022,8 +1061,8 @@ } } - else if (! strcmp (buffer, "defvar") || - ! strcmp (buffer, "defconst")) + else if (! strcmp (buffer, "defvar") + || ! strcmp (buffer, "defconst")) { char c1 = 0, c2 = 0; type = 'V'; @@ -1032,15 +1071,73 @@ if (saved_string == 0) { - /* Skip until the first newline; remember the two previous - chars. */ + /* Skip until the end of line; remember two previous chars. */ while (c != '\n' && c >= 0) { c2 = c1; c1 = c; c = getc_skipping_iso2022 (infile); } + + /* If two previous characters were " and \, + this is a doc string. Otherwise, there is none. */ + if (c2 != '"' || c1 != '\\') + { +#ifdef DEBUG + fprintf (stderr, "## non-docstring in %s (%s)\n", + buffer, filename); +#endif + continue; + } + } + } + else if (! strcmp (buffer, "custom-declare-variable")) + { + char c1 = 0, c2 = 0; + type = 'V'; + + c = getc (infile); + if (c == '\'') + read_lisp_symbol (infile, buffer); + else + { + if (c != '(') + { + fprintf (stderr, + "## unparsable name in custom-declare-variable in %s\n", + filename); + continue; + } + read_lisp_symbol (infile, buffer); + if (strcmp (buffer, "quote")) + { + fprintf (stderr, + "## unparsable name in custom-declare-variable in %s\n", + filename); + continue; + } + read_lisp_symbol (infile, buffer); + c = getc (infile); + if (c != ')') + { + fprintf (stderr, + "## unparsable quoted name in custom-declare-variable in %s\n", + filename); + continue; + } + } + + if (saved_string == 0) + { + /* Skip to end of line; remember the two previous chars. */ + while (c != '\n' && c >= 0) + { + c2 = c1; + c1 = c; + c = getc_skipping_iso2022 (infile); + } + /* If two previous characters were " and \, this is a doc string. Otherwise, there is none. */ if (c2 != '"' || c1 != '\\') @@ -1090,15 +1187,14 @@ if (saved_string == 0) { - /* Skip until the first newline; remember the two previous - chars. */ + /* Skip to end of line; remember the two previous chars. */ while (c != '\n' && c >= 0) { c2 = c1; c1 = c; c = getc_skipping_iso2022 (infile); } - + /* If two previous characters were " and \, this is a doc string. Otherwise, there is none. */ if (c2 != '"' || c1 != '\\') @@ -1171,8 +1267,8 @@ } #if 0 /* causes crash */ - else if (! strcmp (buffer, "if") || - ! strcmp (buffer, "byte-code")) + else if (! strcmp (buffer, "if") + || ! strcmp (buffer, "byte-code")) ; #endif @@ -1188,9 +1284,10 @@ /* At this point, we should either use the previous dynamic doc string in saved_string or gobble a doc string from the input file. - + In the latter case, the opening quote (and leading backslash-newline) have already been read. */ + putc ('\n', outfile); /* XEmacs addition */ putc (037, outfile); putc (type, outfile);
--- a/lisp/ChangeLog Sun Jul 21 04:51:07 2002 +0000 +++ b/lisp/ChangeLog Tue Jul 23 08:35:11 2002 +0000 @@ -1,3 +1,10 @@ +2002-07-21 John Paul Wallington <jpw@xemacs.org> + + * process.el (substitute-env-vars): New function; sync with + GNU Emacs 21.1.50. + (setenv): Add optional arg SUBSTITUTE-ENV-VARS; sync with + GNU Emacs 21.1.50. + 2002-07-17 Steve Youngs <youngs@xemacs.org> * package-get.el (package-get-update-base-from-buffer): Re-write
--- a/lisp/process.el Sun Jul 21 04:51:07 2002 +0000 +++ b/lisp/process.el Tue Jul 23 08:35:11 2002 +0000 @@ -535,11 +535,40 @@ ;; History list for VALUE argument to setenv. (defvar setenv-history nil) -(defun setenv (variable &optional value unset) +(defun substitute-env-vars (string) + "Substitute environment variables referred to in STRING. +`$FOO' where FOO is an environment variable name means to substitute +the value of that variable. The variable name should be terminated +with a character not a letter, digit or underscore; otherwise, enclose +the entire variable name in braces. Use `$$' to insert a single +dollar sign." + (let ((start 0)) + (while (string-match + ;; XEmacs change - FSF use their rx macro to generate this regexp + "\\(?:\\$\\(\\(?:[a-zA-Z0-9_]\\)+\\)\\)\\|\\(?:\\${\\(\\(?:.\\|\n\\)*?\\)}\\)\\|\\$\\$" + string start) + (cond ((match-beginning 1) + (let ((value (getenv (match-string 1 string)))) + (setq string (replace-match (or value "") t t string) + start (+ (match-beginning 0) (length value))))) + ((match-beginning 2) + (let ((value (getenv (match-string 2 string)))) + (setq string (replace-match (or value "") t t string) + start (+ (match-beginning 0) (length value))))) + (t + (setq string (replace-match "$" t t string) + start (+ (match-beginning 0) 1))))) + string)) + +(defun setenv (variable &optional value unset substitute-env-vars) "Set the value of the environment variable named VARIABLE to VALUE. VARIABLE should be a string. VALUE is optional; if not provided or is `nil', the environment variable VARIABLE will be removed. +UNSET, if non-nil, means to remove VARIABLE from the environment. +SUBSTITUTE-ENV-VARS, if non-nil, means to substitute environment +variables in VALUE using `substitute-env-vars'. + Interactively, a prefix argument means to unset the variable. Interactively, the current value (if any) of the variable appears at the front of the history list when you type in the new value. @@ -553,7 +582,10 @@ (list var (read-from-minibuffer (format "Set %s to value: " var) nil nil nil 'setenv-history (getenv var)))))) - (if unset (setq value nil)) + (if unset + (setq value nil) + (if substitute-env-vars + (setq value (substitute-env-vars value)))) (if (string-match "=" variable) (error "Environment variable name `%s' contains `='" variable) (let ((pattern (concat "\\`" (regexp-quote (concat variable "="))))
--- a/src/ChangeLog Sun Jul 21 04:51:07 2002 +0000 +++ b/src/ChangeLog Tue Jul 23 08:35:11 2002 +0000 @@ -1,3 +1,27 @@ +2002-07-20 Mike Sperber <mike@xemacs.org> + + * eval.c (run_post_gc_hook): Use more correct flags when running + post-gc-hook. + +2002-07-20 Mike Sperber <mike@xemacs.org> + + * process-unix.c (child_setup): Don't try to close file + descriptors for chid process once again---it's already being done + in close_process_descs. + (unix_create_process): Call begin_dont_check_for_quit to inhibit + unwanted interaction (and thus breaking of X event synchronicity) + in the child. + +2002-07-15 Jerry James <james@xemacs.org> + + * lisp.h: Make Qdll_error visible globally. + * symbols.c (check_sane_subr): Revert 2002-06-26 change. + Check only if !initialized. + * symbols.c (check_module_subr): Add parameter. Duplicate + check_sane_subr checks, but signal an error instead of asserting. + * symbols.c (defsubr): Use check_module_subr parameter. + * symbols.c (defsubr_macro): Ditto. + 2002-07-09 Mike Sperber <mike@xemacs.org> * config.h.in: Add USE_KKCC variable to enable upcoming new GC
--- a/src/eval.c Sun Jul 21 04:51:07 2002 +0000 +++ b/src/eval.c Tue Jul 23 08:35:11 2002 +0000 @@ -5537,7 +5537,7 @@ ("Error in post-gc-hook", 2, args, RUN_HOOKS_TO_COMPLETION, - INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION); + INHIBIT_QUIT | NO_INHIBIT_ERRORS); } /************************************************************************/
--- a/src/lisp.h Sun Jul 21 04:51:07 2002 +0000 +++ b/src/lisp.h Tue Jul 23 08:35:11 2002 +0000 @@ -4967,7 +4967,7 @@ extern Lisp_Object Qconversion_error, Qcurrent_menubar; extern Lisp_Object Qcyclic_variable_indirection, Qdefun, Qdevice_live_p, Qdim; extern Lisp_Object Qdirection, Qdisabled, Qdisabled_command_hook; -extern Lisp_Object Qdisplay_table, Qdomain_error, Qediting_error; +extern Lisp_Object Qdisplay_table, Qdll_error, Qdomain_error, Qediting_error; extern Lisp_Object Qend_of_buffer, Qend_of_file, Qend_open, Qerror; extern Lisp_Object Qerror_conditions, Qerror_lacks_explanatory_string; extern Lisp_Object Qerror_message, Qevent_live_p, Qexit, Qextent_live_p;
--- a/src/process-unix.c Sun Jul 21 04:51:07 2002 +0000 +++ b/src/process-unix.c Tue Jul 23 08:35:11 2002 +0000 @@ -1023,19 +1023,6 @@ retry_close (out); retry_close (err); - /* I can't think of any reason why child processes need any more - than the standard 3 file descriptors. It would be cleaner to - close just the ones that need to be, but the following brute - force approach is certainly effective, and not too slow. - - #### Who the hell added this? We already close the descriptors - by using close_process_descs()!!! --ben */ - { - int fd; - for (fd = 3; fd <= 64; fd++) - retry_close (fd); - } - /* we've wrapped execve; it translates its arguments */ qxe_execve (new_argv[0], new_argv, env); @@ -1140,6 +1127,10 @@ int xforkout = forkout; int xforkerr = forkerr; + /* Checking for quit in the child is bad because that will + cause I/O, and that, in turn, can confuse the X connection. */ + begin_dont_check_for_quit(); + /* Disconnect the current controlling terminal, pursuant to making the pty be the controlling terminal of the process. Also put us in our own process group. */
--- a/src/symbols.c Sun Jul 21 04:51:07 2002 +0000 +++ b/src/symbols.c Tue Jul 23 08:35:11 2002 +0000 @@ -3358,25 +3358,24 @@ } #ifdef DEBUG_XEMACS -/* Check that nobody spazzed writing a DEFUN. */ +/* Check that nobody spazzed writing a builtin (non-module) DEFUN. */ static void check_sane_subr (Lisp_Subr *subr, Lisp_Object sym) { - Lisp_Object f; - - assert (subr->min_args >= 0); - assert (subr->min_args <= SUBR_MAX_ARGS); - - if (subr->max_args != MANY && - subr->max_args != UNEVALLED) - { - /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */ - assert (subr->max_args <= SUBR_MAX_ARGS); - assert (subr->min_args <= subr->max_args); - } - - f = XSYMBOL (sym)->function; - assert (UNBOUNDP (f) || (CONSP (f) && EQ (XCAR (f), Qautoload))); + if (!initialized) { + assert (subr->min_args >= 0); + assert (subr->min_args <= SUBR_MAX_ARGS); + + if (subr->max_args != MANY && + subr->max_args != UNEVALLED) + { + /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */ + assert (subr->max_args <= SUBR_MAX_ARGS); + assert (subr->min_args <= subr->max_args); + } + + assert (UNBOUNDP (XSYMBOL (sym)->function)); + } } #else #define check_sane_subr(subr, sym) /* nothing */ @@ -3407,17 +3406,43 @@ * FIXME: Should newsubr be staticpro()'ed? I don't think so but I need * a guru to check. */ -#define check_module_subr() \ -do { \ - if (initialized) { \ - Lisp_Subr *newsubr = (Lisp_Subr *) xmalloc (sizeof (Lisp_Subr)); \ - memcpy (newsubr, subr, sizeof (Lisp_Subr)); \ - subr->doc = (const char *)newsubr; \ - subr = newsubr; \ - } \ +#define check_module_subr(subr) \ +do { \ + if (initialized) { \ + Lisp_Subr *newsubr; \ + Lisp_Object f; \ + \ + if (subr->min_args < 0) \ + signal_ferror (Qdll_error, "%s min_args (%hd) too small", \ + subr_name (subr), subr->min_args); \ + if (subr->min_args > SUBR_MAX_ARGS) \ + signal_ferror (Qdll_error, "%s min_args (%hd) too big (max = %d)", \ + subr_name (subr), subr->min_args, SUBR_MAX_ARGS); \ + \ + if (subr->max_args != MANY && \ + subr->max_args != UNEVALLED) \ + { \ + /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */ \ + if (subr->max_args > SUBR_MAX_ARGS) \ + signal_ferror (Qdll_error, "%s max_args (%hd) too big (max = %d)", \ + subr_name (subr), subr->max_args, SUBR_MAX_ARGS); \ + if (subr->min_args > subr->max_args) \ + signal_ferror (Qdll_error, "%s min_args (%hd) > max_args (%hd)", \ + subr_name (subr), subr->min_args, subr->max_args); \ + } \ + \ + f = XSYMBOL (sym)->function; \ + if (!UNBOUNDP (f) && (!CONSP (f) || !EQ (XCAR (f), Qautoload))) \ + signal_ferror (Qdll_error, "Attempt to redefine %s", subr_name (subr)); \ + \ + newsubr = (Lisp_Subr *) xmalloc (sizeof (Lisp_Subr)); \ + memcpy (newsubr, subr, sizeof (Lisp_Subr)); \ + subr->doc = (const char *)newsubr; \ + subr = newsubr; \ + } \ } while (0) #else /* ! HAVE_SHLIB */ -#define check_module_subr() +#define check_module_subr(subr) #endif void @@ -3427,7 +3452,7 @@ Lisp_Object fun; check_sane_subr (subr, sym); - check_module_subr (); + check_module_subr (subr); fun = wrap_subr (subr); XSYMBOL (sym)->function = fun; @@ -3441,7 +3466,7 @@ Lisp_Object fun; check_sane_subr (subr, sym); - check_module_subr(); + check_module_subr (subr); fun = wrap_subr (subr); XSYMBOL (sym)->function = Fcons (Qmacro, fun);