/* 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;
Fdelete_directory. */
int delete_by_moving_to_trash;
+Lisp_Object Qdelete_by_moving_to_trash;
+
/* Lisp function for moving files to trash. */
Lisp_Object Qmove_file_to_trash;
file names in the file system.
An initial `~/' expands to your home directory.
An initial `~USER/' expands to USER's home directory.
-See also the function `substitute-in-file-name'. */)
+See also the function `substitute-in-file-name'.
+
+For technical reasons, this function can return correct but
+non-intuitive results for the root directory; for instance,
+\(expand-file-name ".." "/") returns "/..". For this reason, use
+(directory-file-name (file-name-directory dirname)) to traverse a
+filesystem tree, not (expand-file-name ".." dirname). */)
(name, default_directory)
Lisp_Object name, default_directory;
{
#endif
&& (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
{
+#ifdef WINDOWSNT
+ unsigned char *prev_o = o;
+#endif
while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
;
+#ifdef WINDOWSNT
+ /* Don't go below server level in UNC filenames. */
+ if (o == target + 1 && IS_DIRECTORY_SEP (*o)
+ && IS_DIRECTORY_SEP (*target))
+ o = prev_o;
+ else
+#endif
/* Keep initial / only if this is the whole name. */
if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
++o;
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;
{
{
if (errno == EXDEV)
{
+ int count;
#ifdef S_IFLNK
symlink_target = Ffile_symlink_p (file);
if (! NILP (symlink_target))
NILP (ok_if_already_exists) ? Qnil : Qt,
Qt, Qt);
+ count = SPECPDL_INDEX ();
+ specbind (Qdelete_by_moving_to_trash, Qnil);
Fdelete_file (file);
+ unbind_to (count, Qnil);
}
else
report_file_error ("Renaming", list2 (file, newname));
"(let ((file (read-file-name \"File: \"))) \
(list file (read-file-modes nil file)))",
doc: /* Set mode bits of file named FILENAME to MODE (an integer).
-Only the 12 low bits of MODE are used. */)
+Only the 12 low bits of MODE are used.
+
+Interactively, mode bits are read by `read-file-modes', which accepts
+symbolic notation, like the `chmod' command from GNU Coreutils. */)
(filename, mode)
Lisp_Object filename, mode;
{
int read_quit = 0;
Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
int we_locked_file = 0;
+ int deferred_remove_unwind_protect = 0;
if (current_buffer->base_buffer && ! NILP (visit))
error ("Cannot do file visiting in an indirect buffer");
UNGCPRO;
emacs_close (fd);
+ /* We should remove the unwind_protect calling
+ close_file_unwind, but other stuff has been added the stack,
+ so defer the removal till we reach the `handled' label. */
+ deferred_remove_unwind_protect = 1;
+
/* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
if we couldn't read the file. */
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)));
handled:
+ if (deferred_remove_unwind_protect)
+ /* If requested above, discard the unwind protect for closing the
+ file. */
+ specpdl_ptr--;
+
if (!NILP (visit))
{
if (!EQ (current_buffer->undo_list, Qt) && !nochange)
\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.
When non-nil, the function `move-file-to-trash' will be used by
`delete-file' and `delete-directory'. */);
delete_by_moving_to_trash = 0;
+ Qdelete_by_moving_to_trash = intern ("delete-by-moving-to-trash");
Qmove_file_to_trash = intern ("move-file-to-trash");
staticpro (&Qmove_file_to_trash);
HCoop / bpt / emacs.git / blobdiff