Mercurial > hg > xemacs-beta

comparison src/lread.c @ 267:966663fcf606 r20-5b32

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b32
author cvs
date Mon, 13 Aug 2007 10:26:29 +0200
parents 8efd647ea9ca
children c5d627a313b1
comparison
equal deleted inserted replaced
266:18d185df8c54 267:966663fcf606
1295 if (BUFFERP (readcharfun)) 1295 if (BUFFERP (readcharfun))
1296 b = XBUFFER (readcharfun); 1296 b = XBUFFER (readcharfun);
1297 else if (MARKERP (readcharfun)) 1297 else if (MARKERP (readcharfun))
1298 b = XMARKER (readcharfun)->buffer; 1298 b = XMARKER (readcharfun)->buffer;
1299 1299
1300 specbind (Qstandard_input, readcharfun); 1300 /* Don't do this. It is not necessary, and it needlessly exposes
1301 READCHARFUN (which can be a stream) to Lisp. --hniksic */
1302 /*specbind (Qstandard_input, readcharfun);*/
1303
1301 specbind (Qcurrent_load_list, Qnil); 1304 specbind (Qcurrent_load_list, Qnil);
1302 1305
1303 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK 1306 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1304 Vcurrent_compiled_function_annotation = Qnil; 1307 Vcurrent_compiled_function_annotation = Qnil;
1305 #endif 1308 #endif
1578 static Emchar 1581 static Emchar
1579 read_escape (Lisp_Object readcharfun) 1582 read_escape (Lisp_Object readcharfun)
1580 { 1583 {
1581 /* This function can GC */ 1584 /* This function can GC */
1582 Emchar c = readchar (readcharfun); 1585 Emchar c = readchar (readcharfun);
1586
1587 if (c < 0)
1588 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1589
1583 switch (c) 1590 switch (c)
1584 { 1591 {
1585 case 'a': return '\007'; 1592 case 'a': return '\007';
1586 case 'b': return '\b'; 1593 case 'b': return '\b';
1587 case 'd': return 0177; 1594 case 'd': return 0177;
1593 case 'v': return '\v'; 1600 case 'v': return '\v';
1594 case '\n': return -1; 1601 case '\n': return -1;
1595 1602
1596 case 'M': 1603 case 'M':
1597 c = readchar (readcharfun); 1604 c = readchar (readcharfun);
1605 if (c < 0)
1606 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1598 if (c != '-') 1607 if (c != '-')
1599 error ("Invalid escape character syntax"); 1608 error ("Invalid escape character syntax");
1600 c = readchar (readcharfun); 1609 c = readchar (readcharfun);
1610 if (c < 0)
1611 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1601 if (c == '\\') 1612 if (c == '\\')
1602 c = read_escape (readcharfun); 1613 c = read_escape (readcharfun);
1603 return c | 0200; 1614 return c | 0200;
1604 1615
1605 #define FSF_KEYS 1616 #define FSF_KEYS
1613 byte_compiled code will still work fsfmacs, though... --Stig 1624 byte_compiled code will still work fsfmacs, though... --Stig
1614 1625
1615 #define ctl_modifier (0x400000) 1626 #define ctl_modifier (0x400000)
1616 #define meta_modifier (0x800000) 1627 #define meta_modifier (0x800000)
1617 */ 1628 */
1618 #define FSF_LOSSAGE(mask) \ 1629 #define FSF_LOSSAGE(mask) \
1619 if (puke_on_fsf_keys || ((c = readchar (readcharfun)) != '-')) \ 1630 if (puke_on_fsf_keys || ((c = readchar (readcharfun)) != '-')) \
1620 error ("Invalid escape character syntax"); \ 1631 error ("Invalid escape character syntax"); \
1621 if ((c = readchar (readcharfun)) == '\\') \ 1632 c = readchar (readcharfun); \
1622 c = read_escape (readcharfun); \ 1633 if (c < 0) \
1634 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun))); \
1635 if (c == '\\') \
1636 c = read_escape (readcharfun); \
1623 return c | mask 1637 return c | mask
1624 1638
1625 case 'S': FSF_LOSSAGE (shift_modifier); 1639 case 'S': FSF_LOSSAGE (shift_modifier);
1626 case 'H': FSF_LOSSAGE (hyper_modifier); 1640 case 'H': FSF_LOSSAGE (hyper_modifier);
1627 case 'A': FSF_LOSSAGE (alt_modifier); 1641 case 'A': FSF_LOSSAGE (alt_modifier);
1634 1648
1635 #endif /* FSF_KEYS */ 1649 #endif /* FSF_KEYS */
1636 1650
1637 case 'C': 1651 case 'C':
1638 c = readchar (readcharfun); 1652 c = readchar (readcharfun);
1653 if (c < 0)
1654 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1639 if (c != '-') 1655 if (c != '-')
1640 error ("Invalid escape character syntax"); 1656 error ("Invalid escape character syntax");
1641 case '^': 1657 case '^':
1642 c = readchar (readcharfun); 1658 c = readchar (readcharfun);
1659 if (c < 0)
1660 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1643 if (c == '\\') 1661 if (c == '\\')
1644 c = read_escape (readcharfun); 1662 c = read_escape (readcharfun);
1645 /* FSFmacs junk for non-ASCII controls. 1663 /* FSFmacs junk for non-ASCII controls.
1646 Not used here. */ 1664 Not used here. */
1647 if (c == '?') 1665 if (c == '?')
1728 )) 1746 ))
1729 { 1747 {
1730 if (c == '\\') 1748 if (c == '\\')
1731 { 1749 {
1732 c = readchar (readcharfun); 1750 c = readchar (readcharfun);
1751 if (c < 0)
1752 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1733 *saw_a_backslash = 1; 1753 *saw_a_backslash = 1;
1734 } 1754 }
1735 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c); 1755 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
1736 QUIT; 1756 QUIT;
1737 c = readchar (readcharfun); 1757 c = readchar (readcharfun);
1820 else 1840 else
1821 { 1841 {
1822 /* intern will purecopy pname if necessary */ 1842 /* intern will purecopy pname if necessary */
1823 Lisp_Object name = make_string ((Bufbyte *) read_ptr, len); 1843 Lisp_Object name = make_string ((Bufbyte *) read_ptr, len);
1824 sym = Fintern (name, Qnil); 1844 sym = Fintern (name, Qnil);
1825 } 1845
1826 if (SYMBOL_IS_KEYWORD (sym)) 1846 if (SYMBOL_IS_KEYWORD (sym))
1827 { 1847 {
1828 /* the LISP way is to put keywords in their own package, but we don't 1848 /* the LISP way is to put keywords in their own package,
1829 have packages, so we do something simpler. Someday, maybe we'll 1849 but we don't have packages, so we do something simpler.
1830 have packages and then this will be reworked. --Stig. */ 1850 Someday, maybe we'll have packages and then this will
1831 XSYMBOL (sym)->value = sym; 1851 be reworked. --Stig. */
1852 XSYMBOL (sym)->value = sym;
1853 }
1832 } 1854 }
1833 return sym; 1855 return sym;
1834 } 1856 }
1835 } 1857 }
1836 1858
2257 #endif 2279 #endif
2258 /* "#["-- byte-code constant syntax */ 2280 /* "#["-- byte-code constant syntax */
2259 /* purecons #[...] syntax */ 2281 /* purecons #[...] syntax */
2260 case '[': return read_compiled_function (readcharfun, ']' 2282 case '[': return read_compiled_function (readcharfun, ']'
2261 /*, purify_flag */ ); 2283 /*, purify_flag */ );
2262 /* "#:"-- quasi-implemented gensym syntax */ 2284 /* "#:"-- gensym syntax */
2263 case ':': return read_atom (readcharfun, -1, 1); 2285 case ':': return read_atom (readcharfun, -1, 1);
2264 /* #'x => (function x) */ 2286 /* #'x => (function x) */
2265 case '\'': return list2 (Qfunction, read0 (readcharfun)); 2287 case '\'': return list2 (Qfunction, read0 (readcharfun));
2266 #if 0 2288 #if 0
2267 /* RMS uses this syntax for fat-strings. 2289 /* RMS uses this syntax for fat-strings.
2970 2992
2971 2993
2972 void 2994 void
2973 init_lread (void) 2995 init_lread (void)
2974 { 2996 {
2975 #ifdef PATH_LOADSEARCH
2976 CONST char *normal = PATH_LOADSEARCH;
2977
2978 /* Don't print this warning. If the hardcoded paths don't exist, then
2979 startup.el will try and deduce one. If it fails, it knows how to
2980 handle things. */
2981 #if 0
2982 #ifndef WINDOWSNT
2983 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
2984 almost never correct, thereby causing a warning to be printed out that
2985 confuses users. Since PATH_LOADSEARCH is always overriden by the
2986 EMACSLOADPATH environment variable below, disable the warning on NT. */
2987
2988 /* Warn if dirs in the *standard* path don't exist. */
2989 if (!turn_off_warning)
2990 {
2991 Lisp_Object normal_path = decode_env_path (0, normal);
2992 for (; !NILP (normal_path); normal_path = XCDR (normal_path))
2993 {
2994 Lisp_Object dirfile;
2995 dirfile = Fcar (normal_path);
2996 if (!NILP (dirfile))
2997 {
2998 dirfile = Fdirectory_file_name (dirfile);
2999 if (access ((char *) XSTRING_DATA (dirfile), 0) < 0)
3000 stdout_out ("Warning: lisp library (%s) does not exist.\n",
3001 XSTRING_DATA (Fcar (normal_path)));
3002 }
3003 }
3004 }
3005 #endif /* WINDOWSNT */
3006 #endif /* 0 */
3007 #else /* !PATH_LOADSEARCH */
3008 CONST char *normal = 0;
3009 #endif /* !PATH_LOADSEARCH */
3010 Vvalues = Qnil; 2997 Vvalues = Qnil;
3011 2998
3012 /* further frobbed by startup.el if nil. */
3013 Vload_path = decode_env_path ("EMACSLOADPATH", normal);
3014
3015 /* Vdump_load_path = Qnil; */
3016 if (purify_flag && NILP (Vload_path))
3017 {
3018 /* loadup.el will frob this some more. */
3019 /* #### unix-specific */
3020 Vload_path = Fcons (build_string ("../lisp/"), Vload_path);
3021 }
3022 load_in_progress = 0; 2999 load_in_progress = 0;
3023 3000
3024 Vload_descriptor_list = Qnil; 3001 Vload_descriptor_list = Qnil;
3002
3003 /* kludge: locate-file does not work for a null load-path, even if
3004 the file name is absolute. */
3005
3006 Vload_path = Fcons (build_string (""), Qnil);
3025 3007
3026 /* This used to get initialized in init_lread because all streams 3008 /* This used to get initialized in init_lread because all streams
3027 got closed when dumping occurs. This is no longer true -- 3009 got closed when dumping occurs. This is no longer true --
3028 Vread_buffer_stream is a resizing output stream, and there is no 3010 Vread_buffer_stream is a resizing output stream, and there is no
3029 reason to close it at dump-time. 3011 reason to close it at dump-time.
3098 otherwise to default specified in by file `paths.h' when XEmacs was built. 3080 otherwise to default specified in by file `paths.h' when XEmacs was built.
3099 If there were no paths specified in `paths.h', then XEmacs chooses a default 3081 If there were no paths specified in `paths.h', then XEmacs chooses a default
3100 value for this variable by looking around in the file-system near the 3082 value for this variable by looking around in the file-system near the
3101 directory in which the XEmacs executable resides. 3083 directory in which the XEmacs executable resides.
3102 */ ); 3084 */ );
3085 Vload_path = Qnil;
3103 3086
3104 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path, 3087 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
3105 "*Location of lisp files to be used when dumping ONLY."); */ 3088 "*Location of lisp files to be used when dumping ONLY."); */
3106 3089
3107 DEFVAR_BOOL ("load-in-progress", &load_in_progress /* 3090 DEFVAR_BOOL ("load-in-progress", &load_in_progress /*