/* File IO for GNU Emacs.
Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
This file is part of GNU Emacs.
/* Functions to be called to create text property annotations for file. */
Lisp_Object Vwrite_region_annotate_functions;
Lisp_Object Qwrite_region_annotate_functions;
+Lisp_Object Vwrite_region_post_annotation_function;
/* During build_annotations, each time an annotation function is called,
this holds the annotations made by the previous functions. */
Lisp_Object Vwrite_region_annotations_so_far;
+/* Each time an annotation function changes the buffer, the new buffer
+ is added here. */
+Lisp_Object Vwrite_region_annotation_buffers;
+
/* File name in which we write a list of all our auto save files. */
Lisp_Object Vauto_save_list_file_name;
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.
-If `/~' appears, all of FILENAME through that `/' is discarded. */)
+
+If `/~' appears, all of FILENAME through that `/' is discarded.
+If `//' appears, everything up to and including the first of
+those `/' is discarded. */)
(filename)
Lisp_Object filename;
{
unsigned char *target = NULL;
int total = 0;
int substituted = 0;
+ int multibyte;
unsigned char *xnm;
Lisp_Object handler;
CHECK_STRING (filename);
+ multibyte = STRING_MULTIBYTE (filename);
+
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
return call2 (handler, Qsubstitute_in_file_name, filename);
nm = SDATA (filename);
-#ifdef DOS_NT
+ /* Always work on a copy of the string, in case GC happens during
+ decode of environment variables, causing the original Lisp_String
+ data to be relocated. */
nm = strcpy (alloca (strlen (nm) + 1), nm);
+#ifdef DOS_NT
CORRECT_DIR_SEPS (nm);
substituted = (strcmp (nm, SDATA (filename)) != 0);
#endif
again. Important with filenames like "/home/foo//:/hello///there"
which whould substitute to "/:/hello///there" rather than "/there". */
return Fsubstitute_in_file_name
- (make_specified_string (p, -1, endp - p,
- STRING_MULTIBYTE (filename)));
-
+ (make_specified_string (p, -1, endp - p, multibyte));
/* See if any variables are substituted into the string
and find the total length of their values in `total' */
/* Get variable value */
o = (unsigned char *) egetenv (target);
if (o)
- { /* Eight-bit chars occupy upto 2 bytes in multibyte. */
- total += strlen (o) * (STRING_MULTIBYTE (filename) ? 2 : 1);
+ {
+ /* Don't try to guess a maximum length - UTF8 can use up to
+ four bytes per character. This code is unlikely to run
+ in a situation that requires performance, so decoding the
+ env variables twice should be acceptable. Note that
+ decoding may cause a garbage collect. */
+ Lisp_Object orig, decoded;
+ orig = make_unibyte_string (o, strlen (o));
+ decoded = DECODE_FILE (orig);
+ total += SBYTES (decoded);
substituted = 1;
}
else if (*p == '}')
*x++ = '$';
strcpy (x, target); x+= strlen (target);
}
- else if (STRING_MULTIBYTE (filename))
- {
- /* If the original string is multibyte,
- convert what we substitute into multibyte. */
- while (*o)
- {
- int c = *o++;
- c = unibyte_char_to_multibyte (c);
- x += CHAR_STRING (c, x);
- }
- }
else
{
- strcpy (x, o);
- x += strlen (o);
+ Lisp_Object orig, decoded;
+ int orig_length, decoded_length;
+ orig_length = strlen (o);
+ orig = make_unibyte_string (o, orig_length);
+ decoded = DECODE_FILE (orig);
+ decoded_length = SBYTES (decoded);
+ strncpy (x, SDATA (decoded), decoded_length);
+ x += decoded_length;
+
+ /* If environment variable needed decoding, return value
+ needs to be multibyte. */
+ if (decoded_length != orig_length
+ || strncmp (SDATA (decoded), o, orig_length))
+ multibyte = 1;
}
}
need to quote some $ to $$ first. */
xnm = p;
- return make_specified_string (xnm, -1, x - xnm, STRING_MULTIBYTE (filename));
+ return make_specified_string (xnm, -1, x - xnm, multibyte);
badsubst:
error ("Bad format environment-variable substitution");
#define READ_BUF_SIZE (64 << 10)
#endif
-extern void adjust_markers_for_delete P_ ((int, int, int, int));
-
/* This function is called after Lisp functions to decide a coding
system are called, or when they cause an error. Before they are
called, the current buffer is set unibyte and it contains only a
/* Used to pass values from insert-file-contents to read_non_regular. */
static int non_regular_fd;
-static int non_regular_inserted;
-static int non_regular_nbytes;
+static EMACS_INT non_regular_inserted;
+static EMACS_INT non_regular_nbytes;
/* Read from a non-regular file.
static Lisp_Object
read_non_regular ()
{
- int nbytes;
+ EMACS_INT nbytes;
immediate_quit = 1;
QUIT;
{
struct stat st;
register int fd;
- int inserted = 0;
+ EMACS_INT inserted = 0;
int nochange = 0;
- register int how_much;
- register int unprocessed;
+ register EMACS_INT how_much;
+ register EMACS_INT unprocessed;
int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
Lisp_Object handler, val, insval, orig_filename, old_undo;
Lisp_Object p;
- int total = 0;
+ EMACS_INT total = 0;
int not_regular = 0;
unsigned char read_buf[READ_BUF_SIZE];
struct coding_system coding;
overflow. The calculations below double the file size
twice, so check that it can be multiplied by 4 safely. */
if (XINT (end) != st.st_size
- || st.st_size > INT_MAX / 4)
+ /* Actually, it should test either INT_MAX or LONG_MAX
+ depending on which one is used for EMACS_INT. But in
+ any case, in practice, this test is redundant with the
+ one above.
+ || st.st_size > INT_MAX / 4 */)
error ("Maximum buffer size exceeded");
/* The file size returned from stat may be zero, but data
We assume that the 1K-byte and 3K-byte for heading
and tailing respectively are sufficient for this
purpose. */
- int nread;
+ EMACS_INT nread;
if (st.st_size <= (1024 * 4))
nread = emacs_read (fd, read_buf, 1024 * 4);
/* same_at_start and same_at_end count bytes,
because file access counts bytes
and BEG and END count bytes. */
- int same_at_start = BEGV_BYTE;
- int same_at_end = ZV_BYTE;
- int overlap;
+ EMACS_INT same_at_start = BEGV_BYTE;
+ EMACS_INT same_at_end = ZV_BYTE;
+ EMACS_INT overlap;
/* There is still a possibility we will find the need to do code
conversion. If that happens, we set this variable to 1 to
give up on handling REPLACE in the optimized way. */
match the text at the beginning of the buffer. */
while (1)
{
- int nread, bufpos;
+ EMACS_INT nread, bufpos;
nread = emacs_read (fd, buffer, sizeof buffer);
if (nread < 0)
already found that decoding is necessary, don't waste time. */
while (!giveup_match_end)
{
- int total_read, nread, bufpos, curpos, trial;
+ EMACS_INT total_read, nread, bufpos, curpos, trial;
/* At what file position are we now scanning? */
curpos = XINT (end) - (ZV_BYTE - same_at_end);
if (! giveup_match_end)
{
- int temp;
+ EMACS_INT temp;
/* We win! We can handle REPLACE the optimized way. */
EMACS_INT overlap;
EMACS_INT bufpos;
unsigned char *decoded;
- int temp;
+ EMACS_INT temp;
int this_count = SPECPDL_INDEX ();
int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
Lisp_Object conversion_buffer;
/* We read one bunch by one (READ_BUF_SIZE bytes) to allow
quitting while reading a huge while. */
/* try is reserved in some compilers (Microsoft C) */
- int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed);
- int this;
+ EMACS_INT trytry = min (total - how_much,
+ READ_BUF_SIZE - unprocessed);
+ EMACS_INT this;
/* Allow quitting out of the actual I/O. */
immediate_quit = 1;
coding.mode &= ~CODING_MODE_LAST_BLOCK;
}
+ coding_system = CODING_ID_NAME (coding.id);
decoded = BUF_BEG_ADDR (XBUFFER (conversion_buffer));
inserted = (BUF_Z_BYTE (XBUFFER (conversion_buffer))
- BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
/* Here, we don't do code conversion in the loop. It is done by
decode_coding_gap after all data are read into the buffer. */
{
- int gap_size = GAP_SIZE;
+ EMACS_INT gap_size = GAP_SIZE;
while (how_much < total)
{
/* try is reserved in some compilers (Microsoft C) */
- int trytry = min (total - how_much, READ_BUF_SIZE);
- int this;
+ EMACS_INT trytry = min (total - how_much, READ_BUF_SIZE);
+ EMACS_INT this;
if (not_regular)
{
{
/* Don't run point motion or modification hooks when decoding. */
int count = SPECPDL_INDEX ();
- int old_inserted = inserted;
+ EMACS_INT old_inserted = inserted;
specbind (Qinhibit_point_motion_hooks, Qt);
specbind (Qinhibit_modification_hooks, Qt);
Hence we temporarily save `point' and `inserted' here and
restore `point' iff format-decode did not insert or delete
any text. Otherwise we leave `point' at point-min. */
- int opoint = PT;
- int opoint_byte = PT_BYTE;
- int oinserted = ZV - BEGV;
+ EMACS_INT opoint = PT;
+ EMACS_INT opoint_byte = PT_BYTE;
+ EMACS_INT oinserted = ZV - BEGV;
int ochars_modiff = CHARS_MODIFF;
TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
{
/* For the rationale of this see the comment on
format-decode above. */
- int opoint = PT;
- int opoint_byte = PT_BYTE;
- int oinserted = ZV - BEGV;
+ EMACS_INT opoint = PT;
+ EMACS_INT opoint_byte = PT_BYTE;
+ EMACS_INT oinserted = ZV - BEGV;
int ochars_modiff = CHARS_MODIFF;
TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
\f
static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object));
-/* If build_annotations switched buffers, switch back to BUF.
- Kill the temporary buffer that was selected in the meantime.
-
- Since this kill only the last temporary buffer, some buffers remain
- not killed if build_annotations switched buffers more than once.
- -- K.Handa */
-
static Lisp_Object
-build_annotations_unwind (buf)
- Lisp_Object buf;
+build_annotations_unwind (arg)
+ Lisp_Object arg;
{
- Lisp_Object tembuf;
-
- if (XBUFFER (buf) == current_buffer)
- return Qnil;
- tembuf = Fcurrent_buffer ();
- Fset_buffer (buf);
- Fkill_buffer (tembuf);
+ Vwrite_region_annotation_buffers = arg;
return Qnil;
}
This does code conversion according to the value of
`coding-system-for-write', `buffer-file-coding-system', or
`file-coding-system-alist', and sets the variable
-`last-coding-system-used' to the coding system actually used. */)
+`last-coding-system-used' to the coding system actually used.
+
+This calls `write-region-annotate-functions' at the start, and
+`write-region-post-annotation-function' at the end. */)
(start, end, filename, append, visit, lockname, mustbenew)
Lisp_Object start, end, filename, append, visit, lockname, mustbenew;
{
Fwiden ();
}
- record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
+ record_unwind_protect (build_annotations_unwind,
+ Vwrite_region_annotation_buffers);
+ Vwrite_region_annotation_buffers = Fcons (Fcurrent_buffer (), Qnil);
count1 = SPECPDL_INDEX ();
given_buffer = current_buffer;
#ifdef CLASH_DETECTION
if (!auto_saving)
- {
-#if 0 /* This causes trouble for GNUS. */
- /* If we've locked this file for some other buffer,
- query before proceeding. */
- if (!visiting && EQ (Ffile_locked_p (lockname), Qt))
- call2 (intern ("ask-user-about-lock"), filename, Vuser_login_name);
-#endif
-
- lock_file (lockname);
- }
+ lock_file (lockname);
#endif /* CLASH_DETECTION */
encoded_filename = ENCODE_FILE (filename);
UNGCPRO;
-#if 0
- /* The new encoding routine doesn't require the following. */
-
- /* Whether VMS or not, we must move the gap to the next of newline
- when we must put designation sequences at beginning of line. */
- if (INTEGERP (start)
- && coding.type == coding_type_iso2022
- && coding.flags & CODING_FLAG_ISO_DESIGNATE_AT_BOL
- && GPT > BEG && GPT_ADDR[-1] != '\n')
- {
- int opoint = PT, opoint_byte = PT_BYTE;
- scan_newline (PT, PT_BYTE, ZV, ZV_BYTE, 1, 0);
- move_gap_both (PT, PT_BYTE);
- SET_PT_BOTH (opoint, opoint_byte);
- }
-#endif
-
failure = 0;
immediate_quit = 1;
}
#endif
- /* Spurious "file has changed on disk" warnings have been
- observed on Suns as well.
- It seems that `close' can change the modtime, under nfs.
-
- (This has supposedly been fixed in Sunos 4,
- but who knows about all the other machines with NFS?) */
-#if 0
-
-#define FOO
- fstat (desc, &st);
-#endif
-
/* NFS can report a write failure now. */
if (emacs_close (desc) < 0)
failure = 1, save_errno = errno;
-#ifndef FOO
stat (fn, &st);
-#endif
+
/* Discard the unwind protect for close_file_unwind. */
specpdl_ptr = specpdl + count1;
- /* Restore the original current buffer. */
- visit_file = unbind_to (count, visit_file);
+
+ /* Call write-region-post-annotation-function. */
+ while (CONSP (Vwrite_region_annotation_buffers))
+ {
+ Lisp_Object buf = XCAR (Vwrite_region_annotation_buffers);
+ if (!NILP (Fbuffer_live_p (buf)))
+ {
+ Fset_buffer (buf);
+ if (FUNCTIONP (Vwrite_region_post_annotation_function))
+ call0 (Vwrite_region_post_annotation_function);
+ }
+ Vwrite_region_annotation_buffers
+ = XCDR (Vwrite_region_annotation_buffers);
+ }
+
+ unbind_to (count, Qnil);
#ifdef CLASH_DETECTION
if (!auto_saving)
been dealt with by this function. */
if (current_buffer != given_buffer)
{
+ Vwrite_region_annotation_buffers
+ = Fcons (Fcurrent_buffer (),
+ Vwrite_region_annotation_buffers);
XSETFASTINT (start, BEGV);
XSETFASTINT (end, ZV);
annotations = Qnil;
Snext_read_file_uses_dialog_p, 0, 0, 0,
doc: /* Return t if a call to `read-file-name' will use a dialog.
The return value is only relevant for a call to `read-file-name' that happens
-before any other event (mouse or keypress) is handeled. */)
+before any other event (mouse or keypress) is handled. */)
()
{
#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
of the form (POSITION . STRING), consisting of strings to be effectively
inserted at the specified positions of the file being written (1 means to
insert before the first byte written). The POSITIONs must be sorted into
-increasing order. If there are several functions in the list, the several
-lists are merged destructively. Alternatively, the function can return
-with a different buffer current; in that case it should pay attention
-to the annotations returned by previous functions and listed in
-`write-region-annotations-so-far'.*/);
+increasing order.
+
+If there are several annotation functions, the lists returned by these
+functions are merged destructively. As each annotation function runs,
+the variable `write-region-annotations-so-far' contains a list of all
+annotations returned by previous annotation functions.
+
+An annotation function can return with a different buffer current.
+Doing so removes the annotations returned by previous functions, and
+resets START and END to `point-min' and `point-max' of the new buffer.
+
+After `write-region' completes, Emacs calls the function stored in
+`write-region-post-annotation-function', once for each buffer that was
+current when building the annotations (i.e., at least once), with that
+buffer current. */);
Vwrite_region_annotate_functions = Qnil;
staticpro (&Qwrite_region_annotate_functions);
Qwrite_region_annotate_functions
= intern ("write-region-annotate-functions");
+ DEFVAR_LISP ("write-region-post-annotation-function",
+ &Vwrite_region_post_annotation_function,
+ doc: /* Function to call after `write-region' completes.
+The function is called with no arguments. If one or more of the
+annotation functions in `write-region-annotate-functions' changed the
+current buffer, the function stored in this variable is called for
+each of those additional buffers as well, in addition to the original
+buffer. The relevant buffer is current during each function call. */);
+ Vwrite_region_post_annotation_function = Qnil;
+ staticpro (&Vwrite_region_annotation_buffers);
+
DEFVAR_LISP ("write-region-annotations-so-far",
&Vwrite_region_annotations_so_far,
doc: /* When an annotation function is called, this holds the previous annotations.