Mercurial > hg > xemacs-beta

comparison src/buffer.c @ 771:943eaba38521

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents a307f9a2021d
children e38acbeb1cae
comparison
equal deleted inserted replaced
770:336a418893b5 771:943eaba38521
1 /* Buffer manipulation primitives for XEmacs. 1 /* Buffer manipulation primitives for XEmacs.
2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc. 2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Sun Microsystems, Inc. 3 Copyright (C) 1995 Sun Microsystems, Inc.
4 Copyright (C) 1995, 1996 Ben Wing. 4 Copyright (C) 1995, 1996, 2000, 2001, 2002 Ben Wing.
5 5
6 This file is part of XEmacs. 6 This file is part of XEmacs.
7 7
8 XEmacs is free software; you can redistribute it and/or modify it 8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the 9 under the terms of the GNU General Public License as published by the
73 #include "casetab.h" 73 #include "casetab.h"
74 #include "commands.h" 74 #include "commands.h"
75 #include "elhash.h" 75 #include "elhash.h"
76 #include "extents.h" 76 #include "extents.h"
77 #include "faces.h" 77 #include "faces.h"
78 #ifdef FILE_CODING
79 #include "file-coding.h" 78 #include "file-coding.h"
80 #endif
81 #include "frame.h" 79 #include "frame.h"
82 #include "insdel.h" 80 #include "insdel.h"
83 #include "lstream.h" 81 #include "lstream.h"
84 #include "process.h" /* for kill_buffer_processes */ 82 #include "process.h" /* for kill_buffer_processes */
85 #ifdef REGION_CACHE_NEEDS_WORK 83 #ifdef REGION_CACHE_NEEDS_WORK
86 #include "region-cache.h" 84 #include "region-cache.h"
87 #endif 85 #endif
88 #include "select.h" /* for select_notify_buffer_kill */ 86 #include "select.h" /* for select_notify_buffer_kill */
89 #include "specifier.h" 87 #include "specifier.h"
90 #include "syntax.h" 88 #include "syntax.h"
91 #include "sysdep.h" /* for getwd */
92 #include "window.h" 89 #include "window.h"
93 90
94 #include "sysfile.h" 91 #include "sysfile.h"
92 #include "sysdir.h"
93
94 #ifdef WIN32_NATIVE
95 #include "syswindows.h"
96 #endif
95 97
96 struct buffer *current_buffer; /* the current buffer */ 98 struct buffer *current_buffer; /* the current buffer */
97 99
98 /* This structure holds the default values of the buffer-local variables 100 /* This structure holds the default values of the buffer-local variables
99 defined with DEFVAR_BUFFER_LOCAL, that have special slots in each buffer. 101 defined with DEFVAR_BUFFER_LOCAL, that have special slots in each buffer.
130 there is a default which is used to initialize newly-creation 132 there is a default which is used to initialize newly-creation
131 buffers and as a reset-value when local-vars are killed. */ 133 buffers and as a reset-value when local-vars are killed. */
132 struct buffer buffer_local_flags; 134 struct buffer buffer_local_flags;
133 135
134 /* This is the initial (startup) directory, as used for the *scratch* buffer. 136 /* This is the initial (startup) directory, as used for the *scratch* buffer.
135 We're making this a global to make others aware of the startup directory. 137 This is no longer global. Use get_initial_directory() to retrieve it.
136 `initial_directory' is stored in external format.
137 */ 138 */
138 char initial_directory[MAXPATHLEN+1]; 139 static Intbyte *initial_directory;
139 140
140 /* This structure holds the names of symbols whose values may be 141 /* This structure holds the names of symbols whose values may be
141 buffer-local. It is indexed and accessed in the same way as the above. */ 142 buffer-local. It is indexed and accessed in the same way as the above. */
142 static Lisp_Object Vbuffer_local_symbols; 143 static Lisp_Object Vbuffer_local_symbols;
143 static void *buffer_local_symbols_saved_slots; 144 static void *buffer_local_symbols_saved_slots;
216 217
217 218
218 static void reset_buffer_local_variables (struct buffer *, int first_time); 219 static void reset_buffer_local_variables (struct buffer *, int first_time);
219 static void nuke_all_buffer_slots (struct buffer *b, Lisp_Object zap); 220 static void nuke_all_buffer_slots (struct buffer *b, Lisp_Object zap);
220 221
221 Lisp_Object
222 make_buffer (struct buffer *buf)
223 {
224 Lisp_Object obj;
225 XSETBUFFER (obj, buf);
226 return obj;
227 }
228
229 static Lisp_Object 222 static Lisp_Object
230 mark_buffer (Lisp_Object obj) 223 mark_buffer (Lisp_Object obj)
231 { 224 {
232 struct buffer *buf = XBUFFER (obj); 225 struct buffer *buf = XBUFFER (obj);
233 226
246 /* Don't mark normally through the children slot. 239 /* Don't mark normally through the children slot.
247 (Actually, in this case, it doesn't matter.) */ 240 (Actually, in this case, it doesn't matter.) */
248 if (! EQ (buf->indirect_children, Qnull_pointer)) 241 if (! EQ (buf->indirect_children, Qnull_pointer))
249 mark_conses_in_list (buf->indirect_children); 242 mark_conses_in_list (buf->indirect_children);
250 243
251 return buf->base_buffer ? make_buffer (buf->base_buffer) : Qnil; 244 return buf->base_buffer ? wrap_buffer (buf->base_buffer) : Qnil;
252 } 245 }
253 246
254 static void 247 static void
255 print_buffer (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 248 print_buffer (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
256 { 249 {
339 { 332 {
340 Lisp_Object buf; 333 Lisp_Object buf;
341 struct gcpro gcpro1; 334 struct gcpro gcpro1;
342 335
343 CHECK_STRING (name); 336 CHECK_STRING (name);
344 name = LISP_GETTEXT (name); /* I18N3 */ 337 name = LISP_GETTEXT (name);
345 GCPRO1 (name); 338 GCPRO1 (name);
346 buf = Fcdr (Fassoc (name, Vbuffer_alist)); 339 buf = Fcdr (Fassoc (name, Vbuffer_alist));
347 UNGCPRO; 340 UNGCPRO;
348 if (NILP (buf) && error_if_deleted_or_does_not_exist) 341 if (NILP (buf) && error_if_deleted_or_does_not_exist)
349 nsberror (name); 342 nsberror (name);
540 (find-file-existing-other-name) isn't looked at in get-file-buffer. 533 (find-file-existing-other-name) isn't looked at in get-file-buffer.
541 This way is more correct. */ 534 This way is more correct. */
542 int count = specpdl_depth (); 535 int count = specpdl_depth ();
543 536
544 specbind (Qfind_file_compare_truenames, Qt); 537 specbind (Qfind_file_compare_truenames, Qt);
545 return unbind_to (count, Fget_file_buffer (filename)); 538 return unbind_to_1 (count, Fget_file_buffer (filename));
546 } 539 }
547 540
548 static struct buffer * 541 static struct buffer *
549 allocate_buffer (void) 542 allocate_buffer (void)
550 { 543 {
669 662
670 /* Use the base buffer's text object. */ 663 /* Use the base buffer's text object. */
671 b->text = b->base_buffer->text; 664 b->text = b->base_buffer->text;
672 b->indirect_children = Qnil; 665 b->indirect_children = Qnil;
673 b->base_buffer->indirect_children = 666 b->base_buffer->indirect_children =
674 Fcons (make_buffer (b), b->base_buffer->indirect_children); 667 Fcons (wrap_buffer (b), b->base_buffer->indirect_children);
675 init_buffer_text (b); 668 init_buffer_text (b);
676 669
677 return finish_init_buffer (b, name); 670 return finish_init_buffer (b, name);
678 } 671 }
679 672
714 */ 707 */
715 (name, ignore)) 708 (name, ignore))
716 { 709 {
717 REGISTER Lisp_Object gentemp, tem; 710 REGISTER Lisp_Object gentemp, tem;
718 int count; 711 int count;
719 char number[10]; 712 Intbyte number[10];
720 713
721 CHECK_STRING (name); 714 CHECK_STRING (name);
722 715
723 name = LISP_GETTEXT (name); 716 name = LISP_GETTEXT (name);
724 #ifdef I18N3 717 #ifdef I18N3
731 return name; 724 return name;
732 725
733 count = 1; 726 count = 1;
734 while (1) 727 while (1)
735 { 728 {
736 sprintf (number, "<%d>", ++count); 729 qxesprintf (number, "<%d>", ++count);
737 gentemp = concat2 (name, build_string (number)); 730 gentemp = concat2 (name, build_intstring (number));
738 if (!NILP (ignore)) 731 if (!NILP (ignore))
739 { 732 {
740 tem = Fstring_equal (gentemp, ignore); 733 tem = Fstring_equal (gentemp, ignore);
741 if (!NILP (tem)) 734 if (!NILP (tem))
742 return gentemp; 735 return gentemp;
781 */ 774 */
782 (buffer)) 775 (buffer))
783 { 776 {
784 struct buffer *buf = decode_buffer (buffer, 0); 777 struct buffer *buf = decode_buffer (buffer, 0);
785 778
786 return buf->base_buffer ? make_buffer (buf->base_buffer) : Qnil; 779 return buf->base_buffer ? wrap_buffer (buf->base_buffer) : Qnil;
787 } 780 }
788 781
789 DEFUN ("buffer-indirect-children", Fbuffer_indirect_children, 0, 1, 0, /* 782 DEFUN ("buffer-indirect-children", Fbuffer_indirect_children, 0, 1, 0, /*
790 Return a list of all indirect buffers whose base buffer is BUFFER. 783 Return a list of all indirect buffers whose base buffer is BUFFER.
791 If BUFFER is indirect, the return value will always be nil; see 784 If BUFFER is indirect, the return value will always be nil; see
888 set_buffer_internal (buf); 881 set_buffer_internal (buf);
889 if (!already && !NILP (flag)) 882 if (!already && !NILP (flag))
890 lock_file (fn); 883 lock_file (fn);
891 else if (already && NILP (flag)) 884 else if (already && NILP (flag))
892 unlock_file (fn); 885 unlock_file (fn);
893 unbind_to (count, Qnil); 886 unbind_to (count);
894 } 887 }
895 } 888 }
896 #endif /* CLASH_DETECTION */ 889 #endif /* CLASH_DETECTION */
897 890
898 /* This is often called when the buffer contents are altered but we 891 /* This is often called when the buffer contents are altered but we
1129 if (INTERACTIVE && !NILP (b->filename) 1122 if (INTERACTIVE && !NILP (b->filename)
1130 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) 1123 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1131 { 1124 {
1132 Lisp_Object killp; 1125 Lisp_Object killp;
1133 GCPRO1 (buf); 1126 GCPRO1 (buf);
1134 killp = call1 1127 killp =
1135 (Qyes_or_no_p, 1128 call1 (Qyes_or_no_p,
1136 (emacs_doprnt_string_c 1129 (emacs_sprintf_string ("Buffer %s modified; kill anyway? ",
1137 ((const Intbyte *) GETTEXT ("Buffer %s modified; kill anyway? "), 1130 XSTRING_DATA (b->name))));
1138 Qnil, -1, XSTRING_DATA (b->name))));
1139 UNGCPRO; 1131 UNGCPRO;
1140 if (NILP (killp)) 1132 if (NILP (killp))
1141 return Qnil; 1133 return Qnil;
1142 b = XBUFFER (buf); /* Hypothetical relocating GC. */ 1134 b = XBUFFER (buf); /* Hypothetical relocating GC. */
1143 } 1135 }
1160 EXTERNAL_LIST_LOOP (tail, Vkill_buffer_query_functions) 1152 EXTERNAL_LIST_LOOP (tail, Vkill_buffer_query_functions)
1161 { 1153 {
1162 if (NILP (call0 (Fcar (tail)))) 1154 if (NILP (call0 (Fcar (tail))))
1163 { 1155 {
1164 UNGCPRO; 1156 UNGCPRO;
1165 return unbind_to (speccount, Qnil); 1157 return unbind_to (speccount);
1166 } 1158 }
1167 } 1159 }
1168 1160
1169 /* Then run the hooks. */ 1161 /* Then run the hooks. */
1170 run_hook (Qkill_buffer_hook); 1162 run_hook (Qkill_buffer_hook);
1173 We do this in C because (a) it's faster, and (b) it needs 1165 We do this in C because (a) it's faster, and (b) it needs
1174 to access data internal to select.c that can't be seen from 1166 to access data internal to select.c that can't be seen from
1175 Lisp (so the Lisp code would just call into C anyway. */ 1167 Lisp (so the Lisp code would just call into C anyway. */
1176 select_notify_buffer_kill (buf); 1168 select_notify_buffer_kill (buf);
1177 1169
1178 unbind_to (speccount, Qnil); 1170 unbind_to (speccount);
1179 UNGCPRO; 1171 UNGCPRO;
1180 b = XBUFFER (buf); /* Hypothetical relocating GC. */ 1172 b = XBUFFER (buf); /* Hypothetical relocating GC. */
1181 } 1173 }
1182 1174
1183 /* We have no more questions to ask. Verify that it is valid 1175 /* We have no more questions to ask. Verify that it is valid
1308 1300
1309 /* Clear away all Lisp objects, so that they 1301 /* Clear away all Lisp objects, so that they
1310 won't be protected from GC. */ 1302 won't be protected from GC. */
1311 nuke_all_buffer_slots (b, Qnil); 1303 nuke_all_buffer_slots (b, Qnil);
1312 1304
1313 unbind_to (speccount, Qnil); 1305 unbind_to (speccount);
1314 } 1306 }
1315 return Qt; 1307 return Qt;
1316 } 1308 }
1317 1309
1318 DEFUN ("record-buffer", Frecord_buffer, 1, 1, 0, /* 1310 DEFUN ("record-buffer", Frecord_buffer, 1, 1, 0, /*
1390 record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); 1382 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1391 1383
1392 Fset_buffer (buffer); 1384 Fset_buffer (buffer);
1393 call0 (function); 1385 call0 (function);
1394 1386
1395 return unbind_to (speccount, Qnil); 1387 return unbind_to (speccount);
1396 } 1388 }
1397 1389
1398 void 1390 void
1399 switch_to_buffer (Lisp_Object bufname, Lisp_Object norecord) 1391 switch_to_buffer (Lisp_Object bufname, Lisp_Object norecord)
1400 { 1392 {
1737 1729
1738 return Fnreverse (val); 1730 return Fnreverse (val);
1739 } 1731 }
1740 1732
1741 #endif /* MEMORY_USAGE_STATS */ 1733 #endif /* MEMORY_USAGE_STATS */
1742 1734
1743
1744 /************************************************************************/
1745 /* Implement TO_EXTERNAL_FORMAT, TO_INTERNAL_FORMAT */
1746 /************************************************************************/
1747
1748 /* This implementation should probably be elsewhere, but it can't be
1749 in file-coding.c since that file is only available if FILE_CODING
1750 is defined. */
1751 #ifdef FILE_CODING
1752 static int
1753 coding_system_is_binary (Lisp_Object coding_system)
1754 {
1755 Lisp_Coding_System *cs = XCODING_SYSTEM (coding_system);
1756 return
1757 (CODING_SYSTEM_TYPE (cs) == CODESYS_NO_CONVERSION &&
1758 CODING_SYSTEM_EOL_TYPE (cs) == EOL_LF &&
1759 EQ (CODING_SYSTEM_POST_READ_CONVERSION (cs), Qnil) &&
1760 EQ (CODING_SYSTEM_PRE_WRITE_CONVERSION (cs), Qnil));
1761 }
1762 #else
1763 #define coding_system_is_binary(coding_system) 1
1764 #endif
1765
1766 typedef struct
1767 {
1768 Dynarr_declare (Intbyte_dynarr *);
1769 } Intbyte_dynarr_dynarr;
1770
1771 typedef struct
1772 {
1773 Dynarr_declare (Extbyte_dynarr *);
1774 } Extbyte_dynarr_dynarr;
1775
1776 static Extbyte_dynarr_dynarr *conversion_out_dynarr_list;
1777 static Intbyte_dynarr_dynarr *conversion_in_dynarr_list;
1778
1779 static int dfc_convert_to_external_format_in_use;
1780 static int dfc_convert_to_internal_format_in_use;
1781
1782 static Lisp_Object
1783 dfc_convert_to_external_format_reset_in_use (Lisp_Object value)
1784 {
1785 dfc_convert_to_external_format_in_use = XINT (value);
1786 return Qnil;
1787 }
1788
1789 static Lisp_Object
1790 dfc_convert_to_internal_format_reset_in_use (Lisp_Object value)
1791 {
1792 dfc_convert_to_internal_format_in_use = XINT (value);
1793 return Qnil;
1794 }
1795
1796 void
1797 dfc_convert_to_external_format (dfc_conversion_type source_type,
1798 dfc_conversion_data *source,
1799 #ifdef FILE_CODING
1800 Lisp_Object coding_system,
1801 #endif
1802 dfc_conversion_type sink_type,
1803 dfc_conversion_data *sink)
1804 {
1805 int count = specpdl_depth ();
1806 Extbyte_dynarr *conversion_out_dynarr;
1807
1808 type_checking_assert
1809 (((source_type == DFC_TYPE_DATA) ||
1810 (source_type == DFC_TYPE_LISP_LSTREAM && LSTREAMP (source->lisp_object)) ||
1811 (source_type == DFC_TYPE_LISP_STRING && STRINGP (source->lisp_object)))
1812 &&
1813 ((sink_type == DFC_TYPE_DATA) ||
1814 (sink_type == DFC_TYPE_LISP_LSTREAM && LSTREAMP (source->lisp_object))));
1815
1816 record_unwind_protect (dfc_convert_to_external_format_reset_in_use,
1817 make_int (dfc_convert_to_external_format_in_use));
1818 if (Dynarr_length (conversion_out_dynarr_list) <=
1819 dfc_convert_to_external_format_in_use)
1820 Dynarr_add (conversion_out_dynarr_list, Dynarr_new (Extbyte));
1821 conversion_out_dynarr = Dynarr_at (conversion_out_dynarr_list,
1822 dfc_convert_to_external_format_in_use);
1823 dfc_convert_to_external_format_in_use++;
1824 Dynarr_reset (conversion_out_dynarr);
1825
1826 #ifdef FILE_CODING
1827 coding_system = Fget_coding_system (coding_system);
1828 #endif
1829
1830 /* Here we optimize in the case where the coding system does no
1831 conversion. However, we don't want to optimize in case the source
1832 or sink is an lstream, since writing to an lstream can cause a
1833 garbage collection, and this could be problematic if the source
1834 is a lisp string. */
1835 if (source_type != DFC_TYPE_LISP_LSTREAM &&
1836 sink_type != DFC_TYPE_LISP_LSTREAM &&
1837 coding_system_is_binary (coding_system))
1838 {
1839 const Intbyte *ptr;
1840 Bytecount len;
1841
1842 if (source_type == DFC_TYPE_LISP_STRING)
1843 {
1844 ptr = XSTRING_DATA (source->lisp_object);
1845 len = XSTRING_LENGTH (source->lisp_object);
1846 }
1847 else
1848 {
1849 ptr = (Intbyte *) source->data.ptr;
1850 len = source->data.len;
1851 }
1852
1853 #ifdef MULE
1854 {
1855 const Intbyte *end;
1856 for (end = ptr + len; ptr < end;)
1857 {
1858 Intbyte c =
1859 (BYTE_ASCII_P (*ptr)) ? *ptr :
1860 (*ptr == LEADING_BYTE_CONTROL_1) ? (*(ptr+1) - 0x20) :
1861 (*ptr == LEADING_BYTE_LATIN_ISO8859_1) ? (*(ptr+1)) :
1862 '~';
1863
1864 Dynarr_add (conversion_out_dynarr, (Extbyte) c);
1865 INC_CHARPTR (ptr);
1866 }
1867 charbpos_checking_assert (ptr == end);
1868 }
1869 #else
1870 Dynarr_add_many (conversion_out_dynarr, ptr, len);
1871 #endif
1872
1873 }
1874 else
1875 {
1876 Lisp_Object streams_to_delete[3];
1877 int delete_count = 0;
1878 Lisp_Object instream, outstream;
1879 Lstream *reader, *writer;
1880 struct gcpro gcpro1, gcpro2;
1881
1882 if (source_type == DFC_TYPE_LISP_LSTREAM)
1883 instream = source->lisp_object;
1884 else if (source_type == DFC_TYPE_DATA)
1885 streams_to_delete[delete_count++] = instream =
1886 make_fixed_buffer_input_stream (source->data.ptr, source->data.len);
1887 else
1888 {
1889 type_checking_assert (source_type == DFC_TYPE_LISP_STRING);
1890 streams_to_delete[delete_count++] = instream =
1891 make_lisp_string_input_stream (source->lisp_object, 0, -1);
1892 }
1893
1894 if (sink_type == DFC_TYPE_LISP_LSTREAM)
1895 outstream = sink->lisp_object;
1896 else
1897 {
1898 type_checking_assert (sink_type == DFC_TYPE_DATA);
1899 streams_to_delete[delete_count++] = outstream =
1900 make_dynarr_output_stream
1901 ((unsigned_char_dynarr *) conversion_out_dynarr);
1902 }
1903
1904 #ifdef FILE_CODING
1905 streams_to_delete[delete_count++] = outstream =
1906 make_encoding_output_stream (XLSTREAM (outstream), coding_system);
1907 #endif
1908
1909 reader = XLSTREAM (instream);
1910 writer = XLSTREAM (outstream);
1911 /* decoding_stream will gc-protect outstream */
1912 GCPRO2 (instream, outstream);
1913
1914 while (1)
1915 {
1916 Bytecount size_in_bytes;
1917 char tempbuf[1024]; /* some random amount */
1918
1919 size_in_bytes = Lstream_read (reader, tempbuf, sizeof (tempbuf));
1920
1921 if (size_in_bytes == 0)
1922 break;
1923 else if (size_in_bytes < 0)
1924 signal_error (Qtext_conversion_error, "Error converting to external format", Qunbound);
1925
1926 size_in_bytes = Lstream_write (writer, tempbuf, size_in_bytes);
1927
1928 if (size_in_bytes <= 0)
1929 signal_error (Qtext_conversion_error, "Error converting to external format", Qunbound);
1930 }
1931
1932 /* Closing writer will close any stream at the other end of writer. */
1933 Lstream_close (writer);
1934 Lstream_close (reader);
1935 UNGCPRO;
1936
1937 /* The idea is that this function will create no garbage. */
1938 while (delete_count)
1939 Lstream_delete (XLSTREAM (streams_to_delete [--delete_count]));
1940 }
1941
1942 unbind_to (count, Qnil);
1943
1944 if (sink_type != DFC_TYPE_LISP_LSTREAM)
1945 {
1946 sink->data.len = Dynarr_length (conversion_out_dynarr);
1947 Dynarr_add (conversion_out_dynarr, '\0'); /* NUL-terminate! */
1948 sink->data.ptr = Dynarr_atp (conversion_out_dynarr, 0);
1949 }
1950 }
1951
1952 void
1953 dfc_convert_to_internal_format (dfc_conversion_type source_type,
1954 dfc_conversion_data *source,
1955 #ifdef FILE_CODING
1956 Lisp_Object coding_system,
1957 #endif
1958 dfc_conversion_type sink_type,
1959 dfc_conversion_data *sink)
1960 {
1961 int count = specpdl_depth ();
1962 Intbyte_dynarr *conversion_in_dynarr;
1963
1964 type_checking_assert
1965 ((source_type == DFC_TYPE_DATA ||
1966 source_type == DFC_TYPE_LISP_LSTREAM)
1967 &&
1968 (sink_type == DFC_TYPE_DATA ||
1969 sink_type == DFC_TYPE_LISP_LSTREAM));
1970
1971 record_unwind_protect (dfc_convert_to_internal_format_reset_in_use,
1972 make_int (dfc_convert_to_internal_format_in_use));
1973 if (Dynarr_length (conversion_in_dynarr_list) <=
1974 dfc_convert_to_internal_format_in_use)
1975 Dynarr_add (conversion_in_dynarr_list, Dynarr_new (Intbyte));
1976 conversion_in_dynarr = Dynarr_at (conversion_in_dynarr_list,
1977 dfc_convert_to_internal_format_in_use);
1978 dfc_convert_to_internal_format_in_use++;
1979 Dynarr_reset (conversion_in_dynarr);
1980
1981 #ifdef FILE_CODING
1982 coding_system = Fget_coding_system (coding_system);
1983 #endif
1984
1985 if (source_type != DFC_TYPE_LISP_LSTREAM &&
1986 sink_type != DFC_TYPE_LISP_LSTREAM &&
1987 coding_system_is_binary (coding_system))
1988 {
1989 #ifdef MULE
1990 const Intbyte *ptr = (const Intbyte *) source->data.ptr;
1991 Bytecount len = source->data.len;
1992 const Intbyte *end = ptr + len;
1993
1994 for (; ptr < end; ptr++)
1995 {
1996 Intbyte c = *ptr;
1997
1998 if (BYTE_ASCII_P (c))
1999 Dynarr_add (conversion_in_dynarr, c);
2000 else if (BYTE_C1_P (c))
2001 {
2002 Dynarr_add (conversion_in_dynarr, LEADING_BYTE_CONTROL_1);
2003 Dynarr_add (conversion_in_dynarr, c + 0x20);
2004 }
2005 else
2006 {
2007 Dynarr_add (conversion_in_dynarr, LEADING_BYTE_LATIN_ISO8859_1);
2008 Dynarr_add (conversion_in_dynarr, c);
2009 }
2010 }
2011 #else
2012 Dynarr_add_many (conversion_in_dynarr, source->data.ptr, source->data.len);
2013 #endif
2014 }
2015 else
2016 {
2017 Lisp_Object streams_to_delete[3];
2018 int delete_count = 0;
2019 Lisp_Object instream, outstream;
2020 Lstream *reader, *writer;
2021 struct gcpro gcpro1, gcpro2;
2022
2023 if (source_type == DFC_TYPE_LISP_LSTREAM)
2024 instream = source->lisp_object;
2025 else
2026 {
2027 type_checking_assert (source_type == DFC_TYPE_DATA);
2028 streams_to_delete[delete_count++] = instream =
2029 make_fixed_buffer_input_stream (source->data.ptr, source->data.len);
2030 }
2031
2032 if (sink_type == DFC_TYPE_LISP_LSTREAM)
2033 outstream = sink->lisp_object;
2034 else
2035 {
2036 type_checking_assert (sink_type == DFC_TYPE_DATA);
2037 streams_to_delete[delete_count++] = outstream =
2038 make_dynarr_output_stream
2039 ((unsigned_char_dynarr *) conversion_in_dynarr);
2040 }
2041
2042 #ifdef FILE_CODING
2043 streams_to_delete[delete_count++] = outstream =
2044 make_decoding_output_stream (XLSTREAM (outstream), coding_system);
2045 #endif
2046
2047 reader = XLSTREAM (instream);
2048 writer = XLSTREAM (outstream);
2049 /* outstream will gc-protect its sink stream, if necessary */
2050 GCPRO2 (instream, outstream);
2051
2052 while (1)
2053 {
2054 Bytecount size_in_bytes;
2055 char tempbuf[1024]; /* some random amount */
2056
2057 size_in_bytes = Lstream_read (reader, tempbuf, sizeof (tempbuf));
2058
2059 if (size_in_bytes == 0)
2060 break;
2061 else if (size_in_bytes < 0)
2062 signal_error (Qtext_conversion_error, "Error converting to internal format", Qunbound);
2063
2064 size_in_bytes = Lstream_write (writer, tempbuf, size_in_bytes);
2065
2066 if (size_in_bytes <= 0)
2067 signal_error (Qtext_conversion_error, "Error converting to internal format", Qunbound);
2068 }
2069
2070 /* Closing writer will close any stream at the other end of writer. */
2071 Lstream_close (writer);
2072 Lstream_close (reader);
2073 UNGCPRO;
2074
2075 /* The idea is that this function will create no garbage. */
2076 while (delete_count)
2077 Lstream_delete (XLSTREAM (streams_to_delete [--delete_count]));
2078 }
2079
2080 unbind_to (count, Qnil);
2081
2082 if (sink_type != DFC_TYPE_LISP_LSTREAM)
2083 {
2084 sink->data.len = Dynarr_length (conversion_in_dynarr);
2085 Dynarr_add (conversion_in_dynarr, '\0'); /* NUL-terminate! */
2086 sink->data.ptr = Dynarr_atp (conversion_in_dynarr, 0);
2087 }
2088 }
2089 1735
2090 1736
2091 void 1737 void
2092 syms_of_buffer (void) 1738 syms_of_buffer (void)
2093 { 1739 {
2159 } 1805 }
2160 1806
2161 void 1807 void
2162 reinit_vars_of_buffer (void) 1808 reinit_vars_of_buffer (void)
2163 { 1809 {
2164 conversion_in_dynarr_list = Dynarr_new2 (Intbyte_dynarr_dynarr,
2165 Intbyte_dynarr *);
2166 conversion_out_dynarr_list = Dynarr_new2 (Extbyte_dynarr_dynarr,
2167 Extbyte_dynarr *);
2168
2169 staticpro_nodump (&Vbuffer_alist); 1810 staticpro_nodump (&Vbuffer_alist);
2170 Vbuffer_alist = Qnil; 1811 Vbuffer_alist = Qnil;
2171 current_buffer = 0; 1812 current_buffer = 0;
2172 } 1813 }
2173 1814
2491 buffer_local_flags.left_margin = make_int (1<<11); 2132 buffer_local_flags.left_margin = make_int (1<<11);
2492 buffer_local_flags.abbrev_table = make_int (1<<12); 2133 buffer_local_flags.abbrev_table = make_int (1<<12);
2493 #ifdef REGION_CACHE_NEEDS_WORK 2134 #ifdef REGION_CACHE_NEEDS_WORK
2494 buffer_local_flags.cache_long_line_scans = make_int (1<<13); 2135 buffer_local_flags.cache_long_line_scans = make_int (1<<13);
2495 #endif 2136 #endif
2496 #ifdef FILE_CODING
2497 buffer_local_flags.buffer_file_coding_system = make_int (1<<14); 2137 buffer_local_flags.buffer_file_coding_system = make_int (1<<14);
2498 #endif
2499 2138
2500 /* #### Warning: 1<<31 is the largest number currently allowable 2139 /* #### Warning: 1<<31 is the largest number currently allowable
2501 due to the XINT() handling of this value. With some 2140 due to the XINT() handling of this value. With some
2502 rearrangement you can get 3 more bits. 2141 rearrangement you can get 3 more bits.
2503 2142
2507 2146
2508 #define BUFFER_SLOTS_SIZE (offsetof (struct buffer, BUFFER_SLOTS_LAST_NAME) - offsetof (struct buffer, BUFFER_SLOTS_FIRST_NAME) + sizeof (Lisp_Object)) 2147 #define BUFFER_SLOTS_SIZE (offsetof (struct buffer, BUFFER_SLOTS_LAST_NAME) - offsetof (struct buffer, BUFFER_SLOTS_FIRST_NAME) + sizeof (Lisp_Object))
2509 #define BUFFER_SLOTS_COUNT (BUFFER_SLOTS_SIZE / sizeof (Lisp_Object)) 2148 #define BUFFER_SLOTS_COUNT (BUFFER_SLOTS_SIZE / sizeof (Lisp_Object))
2510 2149
2511 void 2150 void
2512 reinit_complex_vars_of_buffer (void) 2151 reinit_complex_vars_of_buffer_runtime_only (void)
2513 { 2152 {
2514 struct buffer *defs, *syms; 2153 struct buffer *defs, *syms;
2515 2154
2516 common_init_complex_vars_of_buffer (); 2155 common_init_complex_vars_of_buffer ();
2517 2156
2608 For a glyph, it is inserted as is. 2247 For a glyph, it is inserted as is.
2609 For a generic specifier (i.e. a specifier of type `generic'), its instance 2248 For a generic specifier (i.e. a specifier of type `generic'), its instance
2610 is computed in the current window using the equivalent of `specifier-instance' 2249 is computed in the current window using the equivalent of `specifier-instance'
2611 and the value is processed. 2250 and the value is processed.
2612 For a list whose car is a symbol, the symbol's value is taken, 2251 For a list whose car is a symbol, the symbol's value is taken,
2252 and if that is non-nil, the cadr of the list is processed recursively.
2253 Otherwise, the caddr of the list (if there is one) is processed.
2254 For a list whose car is a boolean specifier, its instance is computed
2255 in the current window using the equivalent of `specifier-instance',
2613 and if that is non-nil, the cadr of the list is processed recursively. 2256 and if that is non-nil, the cadr of the list is processed recursively.
2614 Otherwise, the caddr of the list (if there is one) is processed. 2257 Otherwise, the caddr of the list (if there is one) is processed.
2615 For a list whose car is a string or list, each element is processed 2258 For a list whose car is a string or list, each element is processed
2616 recursively and the results are effectively concatenated. 2259 recursively and the results are effectively concatenated.
2617 For a list whose car is an integer, the cdr of the list is processed 2260 For a list whose car is an integer, the cdr of the list is processed
2638 %S -- print name of selected frame (only meaningful under X Windows). 2281 %S -- print name of selected frame (only meaningful under X Windows).
2639 %p -- print percent of buffer above top of window, or Top, Bot or All. 2282 %p -- print percent of buffer above top of window, or Top, Bot or All.
2640 %P -- print percent of buffer above bottom of window, perhaps plus Top, 2283 %P -- print percent of buffer above bottom of window, perhaps plus Top,
2641 or print Bottom or All. 2284 or print Bottom or All.
2642 %n -- print Narrow if appropriate. 2285 %n -- print Narrow if appropriate.
2643 %C -- under XEmacs/mule, print the mnemonic for `buffer-file-coding-system'. 2286 %C -- print the mnemonic for `buffer-file-coding-system'.
2644 %[ -- print one [ for each recursive editing level. %] similar. 2287 %[ -- print one [ for each recursive editing level. %] similar.
2645 %% -- print %. %- -- print infinitely many dashes. 2288 %% -- print %. %- -- print infinitely many dashes.
2646 Decimal digits after the % specify field width to which to pad. 2289 Decimal digits after the % specify field width to which to pad.
2647 */ ); 2290 */ );
2648 2291
2726 DEFVAR_BUFFER_LOCAL ("default-directory", directory /* 2369 DEFVAR_BUFFER_LOCAL ("default-directory", directory /*
2727 Name of default directory of current buffer. Should end with slash. 2370 Name of default directory of current buffer. Should end with slash.
2728 Each buffer has its own value of this variable. 2371 Each buffer has its own value of this variable.
2729 */ ); 2372 */ );
2730 2373
2731 #ifdef FILE_CODING 2374 /* NOTE: The default value is set in code-init.el. */
2732 DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-coding-system", buffer_file_coding_system /* 2375 DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-coding-system", buffer_file_coding_system /*
2733 Default value of `buffer-file-coding-system' for buffers that do not override it. 2376 Default value of `buffer-file-coding-system' for buffers that do not override it.
2734 This is the same as (default-value 'buffer-file-coding-system). 2377 This is the same as (default-value 'buffer-file-coding-system).
2735 This value is used both for buffers without associated files and 2378 This value is used both for buffers without associated files and
2736 for buffers whose files do not have any apparent coding system. 2379 for buffers whose files do not have any apparent coding system.
2770 data -- there may be stray ESC characters when the file is read by 2413 data -- there may be stray ESC characters when the file is read by
2771 another program. 2414 another program.
2772 2415
2773 `buffer-file-coding-system' does *not* control the coding system used when 2416 `buffer-file-coding-system' does *not* control the coding system used when
2774 a file is read in. Use the variables `buffer-file-coding-system-for-read' 2417 a file is read in. Use the variables `buffer-file-coding-system-for-read'
2775 and `buffer-file-coding-system-alist' for that. From a Lisp program, if 2418 and `file-coding-system-alist' for that. From a Lisp program, if
2776 you wish to unilaterally specify the coding system used for one 2419 you wish to unilaterally specify the coding system used for one
2777 particular operation, you should bind the variable 2420 particular operation, you should bind the variable
2778 `coding-system-for-read' rather than changing the other two 2421 `coding-system-for-read' rather than changing the other two
2779 variables just mentioned, which are intended to be used for 2422 variables just mentioned, which are intended to be used for
2780 global environment specification. 2423 global environment specification.
2781 */ ); 2424
2782 #endif /* FILE_CODING */ 2425 See `insert-file-contents' for a full description of how a file's
2426 coding system is determined when it is read in.
2427 */ );
2783 2428
2784 DEFVAR_BUFFER_LOCAL ("auto-fill-function", auto_fill_function /* 2429 DEFVAR_BUFFER_LOCAL ("auto-fill-function", auto_fill_function /*
2785 Function called (if non-nil) to perform auto-fill. 2430 Function called (if non-nil) to perform auto-fill.
2786 It is called after self-inserting a space at a column beyond `fill-column'. 2431 It is called after self-inserting a space at a column beyond `fill-column'.
2787 Each buffer has its own value of this variable. 2432 Each buffer has its own value of this variable.
3034 } 2679 }
3035 2680
3036 #ifndef WIN32_NATIVE 2681 #ifndef WIN32_NATIVE
3037 /* Is PWD another name for `.' ? */ 2682 /* Is PWD another name for `.' ? */
3038 static int 2683 static int
3039 directory_is_current_directory (Extbyte *pwd) 2684 directory_is_current_directory (Intbyte *pwd)
3040 { 2685 {
3041 Intbyte *pwd_internal;
3042 Bytecount pwd_internal_len;
3043 struct stat dotstat, pwdstat; 2686 struct stat dotstat, pwdstat;
3044 2687
3045 TO_INTERNAL_FORMAT (DATA, (pwd, strlen ((char *)pwd) + 1), 2688 return (IS_DIRECTORY_SEP (*pwd)
3046 ALLOCA, (pwd_internal, pwd_internal_len), 2689 && qxe_stat (pwd, &pwdstat) == 0
3047 Qfile_name); 2690 && qxe_stat ((Intbyte *) ".", &dotstat) == 0
3048
3049 return (IS_DIRECTORY_SEP (*pwd_internal)
3050 && xemacs_stat ((char *) pwd_internal, &pwdstat) == 0
3051 && xemacs_stat (".", &dotstat) == 0
3052 && dotstat.st_ino == pwdstat.st_ino 2691 && dotstat.st_ino == pwdstat.st_ino
3053 && dotstat.st_dev == pwdstat.st_dev 2692 && dotstat.st_dev == pwdstat.st_dev);
3054 && pwd_internal_len < MAXPATHLEN);
3055 } 2693 }
3056 #endif 2694 #endif
2695
2696 /* A stand-in for getcwd() #### Fix not to depend on arbitrary size limits */
2697
2698 Intbyte *
2699 get_initial_directory (Intbyte *pathname, Bytecount size)
2700 {
2701 if (pathname)
2702 {
2703 qxestrncpy (pathname, initial_directory, size);
2704 pathname[size - 1] = '\0';
2705 }
2706 return initial_directory;
2707 }
3057 2708
3058 void 2709 void
3059 init_initial_directory (void) 2710 init_initial_directory (void)
3060 { 2711 {
3061 /* This function can GC */ 2712 /* This function can GC */
3062 2713
3063 #ifndef WIN32_NATIVE 2714 #ifndef WIN32_NATIVE
3064 Extbyte *pwd; 2715 Intbyte *pwd;
3065 #endif 2716 #endif
3066
3067 initial_directory[0] = 0;
3068 2717
3069 /* If PWD is accurate, use it instead of calling getcwd. This is faster 2718 /* If PWD is accurate, use it instead of calling getcwd. This is faster
3070 when PWD is right, and may avoid a fatal error. */ 2719 when PWD is right, and may avoid a fatal error. */
3071 #ifndef WIN32_NATIVE 2720 #ifndef WIN32_NATIVE
3072 if ((pwd = (Extbyte *) getenv ("PWD")) != NULL 2721 if ((pwd = egetenv ("PWD")) != NULL
3073 && directory_is_current_directory (pwd)) 2722 && directory_is_current_directory (pwd))
3074 strcpy (initial_directory, (char *) pwd); 2723 initial_directory = qxestrdup (pwd);
3075 else 2724 else
3076 #endif 2725 #endif
3077 if (getcwd (initial_directory, MAXPATHLEN) == NULL) 2726 if ((initial_directory = qxe_allocating_getcwd ()) == NULL)
3078 fatal ("`getcwd' failed: %s\n", strerror (errno)); 2727 {
2728 Intbyte *errmess;
2729 GET_STRERROR (errmess, errno);
2730 fatal ("`getcwd' failed: %s\n", errmess);
2731 }
3079 2732
3080 /* Make sure pwd is DIRECTORY_SEP-terminated. 2733 /* Make sure pwd is DIRECTORY_SEP-terminated.
3081 Maybe this should really use some standard subroutine 2734 Maybe this should really use some standard subroutine
3082 whose definition is filename syntax dependent. */ 2735 whose definition is filename syntax dependent. */
3083 { 2736 {
3084 int len = strlen (initial_directory); 2737 Bytecount len = qxestrlen (initial_directory);
3085 2738
3086 if (! IS_DIRECTORY_SEP (initial_directory[len - 1])) 2739 if (! IS_DIRECTORY_SEP (initial_directory[len - 1]))
3087 { 2740 {
2741 XREALLOC_ARRAY (initial_directory, Intbyte, len + 2);
3088 initial_directory[len] = DIRECTORY_SEP; 2742 initial_directory[len] = DIRECTORY_SEP;
3089 initial_directory[len + 1] = '\0'; 2743 initial_directory[len + 1] = '\0';
3090 } 2744 }
3091 } 2745 }
3092 2746
3093 #ifdef CORRECT_DIR_SEPS 2747 #ifdef WIN32_NATIVE
3094 CORRECT_DIR_SEPS (initial_directory); 2748 {
2749 Intbyte *newinit = mswindows_canonicalize_filename (initial_directory);
2750 xfree (initial_directory);
2751 initial_directory = newinit;
2752 }
2753
2754 {
2755 /* Make the real wd be the location of xemacs.exe to avoid conflicts
2756 when renaming or deleting directories. (We also don't call chdir
2757 when running subprocesses for the same reason.) */
2758
2759 Extbyte *p;
2760 Extbyte modname[MAX_PATH * MAX_XETCHAR_SIZE];
2761
2762 if (!qxeGetModuleFileName (NULL, modname, MAX_PATH))
2763 abort ();
2764 if ((p = xetcsrchr (modname, '\\')) == NULL)
2765 abort ();
2766 XECOPY_TCHAR (p, '\0');
2767
2768 qxeSetCurrentDirectory (modname);
2769 }
3095 #endif 2770 #endif
3096 } 2771 }
3097 2772
3098 void 2773 void
3099 init_buffer (void) 2774 init_buffer_1 (void)
2775 {
2776 Fset_buffer (Fget_buffer_create (QSscratch));
2777 }
2778
2779 void
2780 init_buffer_2 (void)
3100 { 2781 {
3101 /* This function can GC */ 2782 /* This function can GC */
3102 2783 Fset_buffer (Fget_buffer (QSscratch));
3103 Fset_buffer (Fget_buffer_create (QSscratch)); 2784
3104 2785 current_buffer->directory = build_intstring (initial_directory);
3105 current_buffer->directory =
3106 build_ext_string (initial_directory, Qfile_name);
3107 2786
3108 #if 0 /* FSFmacs */ 2787 #if 0 /* FSFmacs */
3109 /* #### is this correct? */ 2788 /* #### is this correct? */
3110 temp = get_minibuffer (0); 2789 temp = get_minibuffer (0);
3111 XBUFFER (temp)->directory = current_buffer->directory; 2790 XBUFFER (temp)->directory = current_buffer->directory;