annotate src/fileio.c @ 872:79c6ff3eef26

[xemacs-hg @ 2002-06-20 21:18:01 by ben] font changes etc.; some 21.4 changes mule/mule-msw-init-late.el: Specify charset->windows-registry conversion. mule/mule-x-init.el: Delete extra mule font additions here. Put them in faces.c. cl-macs.el: Document better. font-lock.el: Move Lisp function regexp to lisp-mode.el. lisp-mode.el: Various indentation fixes: Handle flet functions better. Handle argument lists in defuns and flets. Handle quoted lists, e.g. property lists -- don't indent like function calls. Distinguish between lambdas and other lists. lisp-mode.el: Handle this form. faces.el, font-menu.el, font.el, gtk-faces.el, msw-faces.el, msw-font-menu.el, x-faces.el, x-init.el: Major overhaul of face-handling code: -- Fix lots of bogus code in msw-faces.el, msw-font-menu.el, font-menu.el that was "truenaming" font specs -- i.e. in the process of frobbing a particular field in a general user-specified font spec with wildcarded fields, sticking in particular values for all the remaining wildcarded fields. This bug was rampant everywhere except in x-faces.el (the oldest and only correctly written code). This also means that we need to work with font names at all times and not font instances, because a font instance is essentially a truenamed font. -- Total rewrite of extremely junky code in msw-faces.el. Work with names as well as font instances, and return names; stop truenaming when canonicalizing and frobbing; fix handling of the combined style field, i.e. weight/slant (also fixed in font.el). -- Totally rewrite the frobbing functions in faces.el. This time, we frob all the instantiators rather than just computing a single instance value and working backwards. That way, e.g., `bold' will work for all charsets that have bold available, rather than only for whatever charset was part of the computed font instance (another example of the truename virus). Also fix up code to look at the fallbacks (all of them) when no global value present, so we don't need to put something in the global value. Intelligently handle a request to frob a buffer locale, rather than signalling an error. When frobbing instantiators, try hard to figure out what device type is associated with them, and frob each according to its own proper device type. Correctly handle inheritance vectors given as instantiators. Preserve existing tags when putting back frobbed instantiators. Extract out general specifier-frobbing code into specifier.el. Document everything cleanly. Do lots of other things better, etc. -- Don't duplicatively set a global specification for the default font -- it's already in the fallback and we no longer need a default global specification present. Delete various code in x-faces.el and msw-faces.el that duplicated the lists of fonts in faces.c. -- init-global-faces was not being called at all under MS Windows! Major bogosity. That caused device-specific values to get stuck into all the fonts, making it very hard to change them -- setting global specs caused nothing to happen. -- Correct weight names in font.el. -- Lots more font fixups in objects*.c. Printer.el: Warning fix. specifier.el: Add more args to map-specifier. Add various "heuristic" specifier functions to aid in creation of specifier-munging code such as in faces.el. subr.el: New functions. lwlib.c: Fix warning. config.inc.samp: Clean up, add args to control fastcall (not yet supported! the changes needed are in another ws of mine), profile support, vc6 support, union-type. xemacs.dsp, xemacs.mak: Semi-major overhaul. Fix bug where dump-id was always getting recomputed, forcing a redump even when nothing changed. Add support for fastcall. Support edit-and-continue (on by default) with vc6. Use incremental linking when doing a debug compilation. Add support for profiling. Consolidate the various debug flags. Partial support for "batch-compiling" -- compiling many files on a single invocation of the compiler. Doesn't seem to help that much for me, so it's not finished or enabled by default. Remove HAVE_MSW_C_DIRED, we always do. Correct some sloppy use of directories. s/cygwin32.h: Allow pdump to work under Cygwin (mmap is broken, so need to undefine HAVE_MMAP). s/win32-common.h, s/windowsnt.h: Support for fastcall. Add WIN32_ANY for identifying all Win32 variants (Cygwin, native, MinGW). Both of these are properly used in another ws. alloc.c, balloon-x.c, buffer.c, bytecode.c, callint.c, cm.c, cmdloop.c, cmds.c, console-gtk.c, console-gtk.h, console-msw.c, console-msw.h, console-stream.c, console-stream.h, console-tty.c, console-tty.h, console-x.c, console-x.h, console.c, console.h, device-gtk.c, device-msw.c, device-tty.c, device-x.c, device.c, device.h, devslots.h, dialog-gtk.c, dialog-msw.c, dialog-x.c, dialog.c, dired-msw.c, editfns.c, emacs.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.c, extents.c, extents.h, faces.c, fileio.c, fns.c, frame-gtk.c, frame-msw.c, frame-tty.c, frame-x.c, frame.c, frame.h, glyphs-eimage.c, glyphs-gtk.c, glyphs-msw.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, gui-gtk.c, gui-msw.c, gui-x.c, gui.c, gutter.c, input-method-xlib.c, intl-encap-win32.c, intl-win32.c, keymap.c, lisp.h, macros.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, menubar.h, minibuf.c, mule-charset.c, nt.c, objects-gtk.c, objects-gtk.h, objects-msw.c, objects-msw.h, objects-tty.c, objects-tty.h, objects-x.c, objects-x.h, objects.c, objects.h, postgresql.c, print.c, process.h, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-tty.c, redisplay-x.c, redisplay.c, redisplay.h, scrollbar-gtk.c, scrollbar-msw.c, scrollbar-x.c, scrollbar.c, select-gtk.c, select-msw.c, select-x.c, select.c, signal.c, sound.c, specifier.c, symbols.c, syntax.c, sysdep.c, syssignal.h, syswindows.h, toolbar-common.c, toolbar-gtk.c, toolbar-msw.c, toolbar-x.c, toolbar.c, unicode.c, window.c, window.h: The following are the major changes made: (1) Separation of various header files into an external and an internal version, similar to the existing separation of process.h and procimpl.h. Eventually this should be done for all Lisp objects. The external version has the same name as currently; the internal adds -impl. The external file has XFOO() macros for objects, but the structure is opaque and defined only in the internal file. It's now reasonable to move all prototypes in lisp.h into the appropriate external file, and this should be done. Currently, separation has been done on extents.h, objects*.h, console.h, device.h, frame.h, and window.h. For c/d/f/w, the most basic properties are available in the external header file, with the macros resolving to functions. In the internal header file, the macros are redefined to directly access the structure. Also, the global MARK_FOO_CHANGED macros have been made into functions so that they can be accessed without needing to include lots of -impl headers -- they are used in almost exclusively in non-time-critical functions, and take up enough time that the function overhead will be negligible. Similarly, the function overhead from making the basic properties mentioned above into functions is negligible, and code that does heavy accessing of c/d/f/w structures inevitably ends up needing the internal header files, anyway. (2) More face changes. -- Major rewrite of objects-msw.c. Now handles wildcard specs properly, rather than "truenaming" (or even worse, signalling an error, which previously happened with some of the fallbacks if you tried to use them in make-font-instance!). -- Split charset matching of fonts into two stages -- one to find a font specifically designed for a particular charset (by examining its registry), the second to find a Unicode font that can support the charset. This needs to proceed as two complete, separate instantiations in order to work properly (otherwise many of the fonts in the HELLO page look wrong). This should also make it easy to support iso10646 (Unicode) fonts under X. -- All default values for fonts are now completely specified in the fallbacks. Stuff from mule-x-init.el has all been moved here, merged with the existing specs, and totally rethought so you get sensible results. (HELLO now looks much better!). -- Generalize the "default X/GTK device" stuff into a per-device-type "default device". -- Add mswindows-{set-}charset-registry. In time, charset<->code-page conversion functions will be removed. -- Wrap protective code around calls to compute device specifier tags, and do this computation before calling the face initialization code because the latter may need these tags to be correctly updated. (3) Other changes. EmacsFrame.c, glyphs-msw.c, eval.c, gui-x.c, intl-encap-win32.c, search.c, signal.c, toolbar-msw.c, unicode.c: Warning fixes. config.h.in: #undefs meant to be frobbed by configure *MUST* go inside of #ifndef WIN32_NO_CONFIGURE, and everything else *MUST* go outside! eval.c: Let detailed backtraces be detailed. specifier.c: Don't override user's print-string-length/print-length settings. glyphs.c: New function image-instance-instantiator. config.h.in, sysdep.c: Changes for fastcall. sysdep.c, nt.c: Fix up a previous botched patch that tried to add support for both EEXIST and EACCES. IF THE BOTCHED PATCH WENT INTO 21.4, THIS FIXUP NEEDS TO GO IN, TOO. search.c: Fix *evil* crash due to incorrect synching of syntax-cache code with 21.1. THIS SHOULD GO INTO 21.4.
author ben
date Thu, 20 Jun 2002 21:19:10 +0000
parents 804517e16990
children 5df795348f45
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* File IO for XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985-1988, 1992-1995 Free Software Foundation, Inc.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3 Copyright (C) 1996, 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Mule 2.0, FSF 19.30. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
23 /* More syncing: FSF Emacs 19.34.6 by Marc Paquette <marcpa@cam.org>
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
24 (Note: Sync messages from Marc Paquette may indicate
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
25 incomplete synching, so beware.) */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
26 /* Mule-ized completely except for the #if 0-code including decrypt-string
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
27 and encrypt-string. --ben 7-2-00 */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
28
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "buffer.h"
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
34 #include "device.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "events.h"
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
36 #include "file-coding.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #include "insdel.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "lstream.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
40 #include "process.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 #include "redisplay.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #include "sysdep.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
43 #include "window-impl.h"
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
44
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #include "sysfile.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #include "sysproc.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #include "syspwd.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #include "systime.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #include "sysdir.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 #ifdef HPUX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 #include <netio.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 #ifdef HPUX_PRE_8_0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 #include <errnet.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 #endif /* HPUX_PRE_8_0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 #endif /* HPUX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
58 #if defined (WIN32_NATIVE) || defined (CYGWIN)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
59 #define WIN32_FILENAMES
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
60 #include "syswindows.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 #define IS_DRIVE(x) isalpha (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 /* Need to lower-case the drive letter, or else expanded
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 filenames will sometimes compare inequal, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 `expand-file-name' doesn't always down-case the drive letter. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 #define DRIVE_LETTER(x) tolower (x)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
66 #endif /* WIN32_NATIVE || CYGWIN */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 int lisp_to_time (Lisp_Object, time_t *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 Lisp_Object time_to_lisp (time_t);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 /* Nonzero during writing of auto-save files */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 static int auto_saving;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 /* Set by auto_save_1 to mode of original file so Fwrite_region_internal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 will create a new file with the same mode as the original */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 static int auto_save_mode_bits;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 /* Alist of elements (REGEXP . HANDLER) for file names
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 whose I/O is done with a special handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 Lisp_Object Vfile_name_handler_alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 /* Format for auto-save files */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 Lisp_Object Vauto_save_file_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 /* Lisp functions for translating file formats */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 Lisp_Object Qformat_decode, Qformat_annotate_function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 /* Functions to be called to process text properties in inserted file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 Lisp_Object Vafter_insert_file_functions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 /* Functions to be called to create text property annotations for file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 Lisp_Object Vwrite_region_annotate_functions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 /* During build_annotations, each time an annotation function is called,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 this holds the annotations made by the previous functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 Lisp_Object Vwrite_region_annotations_so_far;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 /* File name in which we write a list of all our auto save files. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 Lisp_Object Vauto_save_list_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
101 /* Prefix used to construct Vauto_save_list_file_name. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
102 Lisp_Object Vauto_save_list_file_prefix;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
103
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
104 /* When non-nil, it prevents auto-save list file creation. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
105 int inhibit_auto_save_session;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
106
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 int disable_auto_save_when_buffer_shrinks;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 Lisp_Object Vdirectory_sep_char;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 /* These variables describe handlers that have "already" had a chance
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 to handle the current operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 Vinhibit_file_name_handlers is a list of file name handlers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 Vinhibit_file_name_operation is the operation being handled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 If we try to handle that operation, we ignore those handlers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 static Lisp_Object Vinhibit_file_name_handlers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 static Lisp_Object Vinhibit_file_name_operation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
121 Lisp_Object Qfile_already_exists;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 Lisp_Object Qauto_save_hook;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 Lisp_Object Qauto_save_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 Lisp_Object Qauto_saving;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 Lisp_Object Qcar_less_than_car;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 Lisp_Object Qcompute_buffer_file_truename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 EXFUN (Frunning_temacs_p, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
133 /* DATA can be anything acceptable to signal_error ().
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
134 */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
135
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
136 DOESNT_RETURN
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
137 report_file_type_error (Lisp_Object errtype, Lisp_Object oserrmess,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
138 const CIbyte *string, Lisp_Object data)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
139 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
140 struct gcpro gcpro1;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
141 Lisp_Object errdata = build_error_data (NULL, data);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
142
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
143 GCPRO1 (errdata);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
144 errdata = Fcons (build_msg_string (string),
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
145 Fcons (oserrmess, errdata));
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
146 signal_error_1 (errtype, errdata);
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
147 /* UNGCPRO; not reached */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
148 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
149
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
150 DOESNT_RETURN
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
151 report_error_with_errno (Lisp_Object errtype,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
152 const CIbyte *string, Lisp_Object data)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
153 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
154 report_file_type_error (errtype, lisp_strerror (errno), string, data);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
155 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
156
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 /* signal a file error when errno contains a meaningful value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 DOESNT_RETURN
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
160 report_file_error (const CIbyte *string, Lisp_Object data)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
162 report_error_with_errno (Qfile_error, string, data);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 /* Just like strerror(3), except return a lisp string instead of char *.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 The string needs to be converted since it may be localized.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
168 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 lisp_strerror (int errnum)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
172 Extbyte *ret = strerror (errnum);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
173 if (!ret)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
174 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
175 Ibyte ffff[99];
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
176 qxesprintf (ffff, "Unknown error %d", errnum);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
177 return build_intstring (ffff);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
178 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
179 return build_ext_string (ret, Qstrerror_encoding);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 close_file_unwind (Lisp_Object fd)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 if (CONSP (fd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 if (INTP (XCAR (fd)))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
188 retry_close (XINT (XCAR (fd)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
190 free_cons (fd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
193 retry_close (XINT (fd));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 delete_stream_unwind (Lisp_Object stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 Lstream_delete (XLSTREAM (stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 /* Restore point, having saved it as a marker. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 restore_point_unwind (Lisp_Object point_marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 BUF_SET_PT (current_buffer, marker_position (point_marker));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 return Fset_marker (point_marker, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 Lisp_Object Qexpand_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 Lisp_Object Qfile_truename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 Lisp_Object Qsubstitute_in_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 Lisp_Object Qdirectory_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 Lisp_Object Qfile_name_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 Lisp_Object Qfile_name_nondirectory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 Lisp_Object Qunhandled_file_name_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 Lisp_Object Qfile_name_as_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 Lisp_Object Qcopy_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 Lisp_Object Qmake_directory_internal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 Lisp_Object Qdelete_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 Lisp_Object Qdelete_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 Lisp_Object Qrename_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 Lisp_Object Qadd_name_to_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 Lisp_Object Qmake_symbolic_link;
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
230 Lisp_Object Qmake_temp_name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 Lisp_Object Qfile_exists_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 Lisp_Object Qfile_executable_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 Lisp_Object Qfile_readable_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 Lisp_Object Qfile_symlink_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 Lisp_Object Qfile_writable_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 Lisp_Object Qfile_directory_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 Lisp_Object Qfile_regular_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 Lisp_Object Qfile_accessible_directory_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 Lisp_Object Qfile_modes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 Lisp_Object Qset_file_modes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 Lisp_Object Qfile_newer_than_file_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 Lisp_Object Qinsert_file_contents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 Lisp_Object Qwrite_region;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 Lisp_Object Qverify_visited_file_modtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 Lisp_Object Qset_visited_file_modtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 /* If FILENAME is handled specially on account of its syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 return its handler function. Otherwise, return nil. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 DEFUN ("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 Return FILENAME's handler function for OPERATION, if it has one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 Otherwise, return nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 A file name is handled if one of the regular expressions in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 `file-name-handler-alist' matches it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 If OPERATION equals `inhibit-file-name-operation', then we ignore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 any handlers that are members of `inhibit-file-name-handlers',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 but we still do run any other handlers. This lets handlers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 use the standard functions without calling themselves recursively.
751
358bd84dc7ff [xemacs-hg @ 2002-02-13 12:55:38 by stephent]
stephent
parents: 707
diff changeset
260
358bd84dc7ff [xemacs-hg @ 2002-02-13 12:55:38 by stephent]
stephent
parents: 707
diff changeset
261 Otherwise, OPERATION is the name of a funcall'able function.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 (filename, operation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 /* This function does not GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 /* This function can be called during GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 /* This function must not munge the match data. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 Lisp_Object chain, inhibited_handlers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 if (EQ (operation, Vinhibit_file_name_operation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 inhibited_handlers = Vinhibit_file_name_handlers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 inhibited_handlers = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 EXTERNAL_LIST_LOOP (chain, Vfile_name_handler_alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 Lisp_Object elt = XCAR (chain);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 if (CONSP (elt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 Lisp_Object string = XCAR (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 if (STRINGP (string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 && (fast_lisp_string_match (string, filename) >= 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 Lisp_Object handler = XCDR (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 if (NILP (Fmemq (handler, inhibited_handlers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 return handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 call2_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 Lisp_Object result = call2 (fn, arg0, arg1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 CHECK_STRING (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 call2_check_string_or_nil (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 Lisp_Object result = call2 (fn, arg0, arg1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 if (!NILP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 CHECK_STRING (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 call3_check_string (Lisp_Object fn, Lisp_Object arg0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 Lisp_Object arg1, Lisp_Object arg2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 Lisp_Object result = call3 (fn, arg0, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 CHECK_STRING (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
327 Return the directory component in file name FILENAME.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
328 Return nil if FILENAME does not include a directory.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 Otherwise return a directory spec.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 Given a Unix syntax file name, returns a string ending in slash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
332 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
334 /* This function can GC. GC checked 2000-07-28 ben */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
335 /* This function synched with Emacs 21.0.103. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
336 Ibyte *beg;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
337 Ibyte *p;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
340 CHECK_STRING (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
344 handler = Ffind_file_name_handler (filename, Qfile_name_directory);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
346 return call2_check_string_or_nil (handler, Qfile_name_directory, filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 #ifdef FILE_SYSTEM_CASE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
349 filename = FILE_SYSTEM_CASE (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
351 beg = XSTRING_DATA (filename);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
352 /* XEmacs: no need to alloca-copy here */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
353 p = beg + XSTRING_LENGTH (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
355 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
356 #ifdef WIN32_FILENAMES
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
357 /* only recognise drive specifier at the beginning */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
358 && !(p[-1] == ':'
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
359 /* handle the "/:d:foo" and "/:foo" cases correctly */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
360 && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
361 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 #endif
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
363 ) p--;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 if (p == beg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 return Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
367 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 /* Expansion of "c:" to drive and default directory. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
369 if (p[-1] == ':')
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
371 Ibyte *res;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
372 Ibyte *wd = mswindows_getdcwd (toupper (*beg) - 'A' + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
373
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
374 res = alloca_array (Ibyte,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
375 (wd ? qxestrlen (wd) : 0) + 10); /* go overboard */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
376 if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
377 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
378 qxestrncpy (res, beg, 2);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
379 beg += 2;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
380 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
381
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
382 if (wd)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
384 qxestrcat (res, wd);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
385 if (!IS_DIRECTORY_SEP (res[qxestrlen (res) - 1]))
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
386 qxestrcat (res, (Ibyte *) "/");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 beg = res;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
388 p = beg + qxestrlen (beg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
390 if (wd)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
391 xfree (wd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
393
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
394 #if 0 /* No! This screws up efs, which calls file-name-directory on URL's
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
395 and expects the slashes to be left alone. This is here because of
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
396 an analogous call in FSF 21. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
397 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
398 Bytecount len = p - beg;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
399 Ibyte *newbeg = alloca_ibytes (len + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
400 Lisp_Object return_me;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
401
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
402 qxestrncpy (newbeg, beg, len);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
403 newbeg[len] = '\0';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
404 newbeg = mswindows_canonicalize_filename (newbeg);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
405 return_me = build_intstring (newbeg);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
406 xfree (newbeg);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
407 return return_me;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
408 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
409 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
410 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 return make_string (beg, p - beg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
415 Return file name FILENAME sans its directory.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 For example, in a Unix-syntax file name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 this is everything after the last slash,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 or the entire name if it contains no slash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
420 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
422 /* This function can GC. GC checked 2000-07-28 ben */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
423 /* This function synched with Emacs 21.0.103. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
424 Ibyte *beg, *p, *end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
427 CHECK_STRING (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
431 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
433 return call2_check_string (handler, Qfile_name_nondirectory, filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
434
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
435 beg = XSTRING_DATA (filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
436 end = p = beg + XSTRING_LENGTH (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
438 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
439 #ifdef WIN32_FILENAMES
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
440 /* only recognise drive specifier at beginning */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
441 && !(p[-1] == ':'
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
442 /* handle the "/:d:foo" case correctly */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
443 && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 #endif
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
445 )
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
446 p--;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 return make_string (p, end - p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 Return a directly usable directory name somehow associated with FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 A `directly usable' directory name is one that may be used without the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 intervention of any file handler.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 If FILENAME is a directly usable file itself, return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 \(file-name-directory FILENAME).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 The `call-process' and `start-process' functions use this function to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 get a current directory to run processes in.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
460 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
462 /* This function can GC. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 return call2 (handler, Qunhandled_file_name_directory,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 return Ffile_name_directory (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
476 static Ibyte *
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
477 file_name_as_directory (Ibyte *out, Ibyte *in)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
479 /* This function cannot GC */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
480 int size = qxestrlen (in);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 if (size == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 out[0] = '.';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 out[1] = DIRECTORY_SEP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 out[2] = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
490 qxestrcpy (out, in);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 /* Append a slash if necessary */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 if (!IS_ANY_SEP (out[size-1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 out[size] = DIRECTORY_SEP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 out[size + 1] = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 return out;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 Return a string representing file FILENAME interpreted as a directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 This operation exists because a directory is also a file, but its name as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 a directory is different from its name as a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 The result can be used as the value of `default-directory'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 or passed as second argument to `expand-file-name'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 For a Unix-syntax file name, just appends a slash,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 except for (file-name-as-directory \"\") => \"./\".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
510 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
512 /* This function can GC. GC checked 2000-07-28 ben */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
513 Ibyte *buf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
516 CHECK_STRING (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
520 handler = Ffind_file_name_handler (filename, Qfile_name_as_directory);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
522 return call2_check_string (handler, Qfile_name_as_directory, filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
523
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
524 buf = alloca_ibytes (XSTRING_LENGTH (filename) + 10);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
525 return build_intstring (file_name_as_directory (buf, XSTRING_DATA (filename)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 * Convert from directory name to filename.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 * On UNIX, it's simple: just make sure there isn't a terminating /
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 * Value is nonzero if the string output is different from the input.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 static int
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
536 directory_file_name (const Ibyte *src, Ibyte *dst)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
538 /* This function cannot GC */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
539 long slen = qxestrlen (src);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 /* Process as Unix format: just remove any final slash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 But leave "/" unchanged; do not change it to "". */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
542 qxestrcpy (dst, src);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 if (slen > 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 && IS_DIRECTORY_SEP (dst[slen - 1])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
545 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 && !IS_ANY_SEP (dst[slen - 2])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
547 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 dst[slen - 1] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
554 Return the file name of the directory named DIRECTORY.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
555 This is the name of the file that holds the data for the directory.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 This operation exists because a directory is also a file, but its name as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 a directory is different from its name as a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 In Unix-syntax, this function just removes the final slash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 (directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
562 /* This function can GC. GC checked 2000-07-28 ben */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
563 Ibyte *buf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 CHECK_STRING (directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 #if 0 /* #### WTF? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 if (NILP (directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 return call2_check_string (handler, Qdirectory_file_name, directory);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
578 buf = (Ibyte *) ALLOCA (XSTRING_LENGTH (directory) + 20);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
579 directory_file_name (XSTRING_DATA (directory), buf);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
580 return build_intstring (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 /* Fmake_temp_name used to be a simple wrapper around mktemp(), but it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 proved too broken for our purposes (it supported only 26 or 62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 unique names under some implementations). For example, this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 arbitrary limit broke generation of Gnus Incoming* files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 This implementation is better than what one usually finds in libc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 --hniksic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
591 static unsigned int temp_name_rand;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
592
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
594 Generate a temporary file name starting with PREFIX.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 The Emacs process number forms part of the result, so there is no
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 danger of generating a name being used by another process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 In addition, this function makes an attempt to choose a name that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 does not specify an existing file. To make this work, PREFIX should
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
600 be an absolute file name. A reasonable idiom is
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
601
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
602 \(make-temp-name (expand-file-name "myprefix" (temp-directory)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
603
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
604 which puts the file in the OS-specified temporary directory.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 (prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
608 static const char tbl[64] =
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
609 {
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 'A','B','C','D','E','F','G','H',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 'I','J','K','L','M','N','O','P',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 'Q','R','S','T','U','V','W','X',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 'Y','Z','a','b','c','d','e','f',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 'g','h','i','j','k','l','m','n',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 'o','p','q','r','s','t','u','v',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 'w','x','y','z','0','1','2','3',
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
617 '4','5','6','7','8','9','-','_'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
618 };
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 Bytecount len;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
621 Ibyte *p, *data;
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
622 Lisp_Object handler;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 CHECK_STRING (prefix);
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
625 handler = Ffind_file_name_handler (prefix, Qmake_temp_name);
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
626 if (!NILP (handler))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
627 return call2_check_string (handler, Qmake_temp_name, prefix);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 a bad idea because:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 1) It might change the prefix, so the resulting string might not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 begin with PREFIX. This violates the principle of least
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 surprise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 2) It breaks under many unforeseeable circumstances, such as with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 the code that uses (make-temp-name "") instead of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 (make-temp-name "./").
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
640 [[ 3) It might yield unexpected (to stat(2)) results in the presence
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
641 of EFS and file name handlers.]] Now that we check for a handler,
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
642 that's less of a concern. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 len = XSTRING_LENGTH (prefix);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
645 data = alloca_ibytes (len + 7);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 memcpy (data, XSTRING_DATA (prefix), len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 p = data + len;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
648 p[6] = '\0';
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 /* VAL is created by adding 6 characters to PREFIX. The first three
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 are the PID of this process, in base 64, and the second three are
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
652 a pseudo-random number seeded from process startup time. This
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
653 ensures 262144 unique file names per PID per PREFIX per machine. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
654
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
655 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
656 unsigned int pid = (unsigned int) qxe_getpid ();
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
657 *p++ = tbl[(pid >> 0) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
658 *p++ = tbl[(pid >> 6) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
659 *p++ = tbl[(pid >> 12) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
660 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 /* Here we try to minimize useless stat'ing when this function is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 invoked many times successively with the same PREFIX. We achieve
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
664 this by using a very pseudo-random number generator to generate
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
665 file names unique to this process, with a very long cycle. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 struct stat ignored;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
670
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
671 p[0] = tbl[(temp_name_rand >> 0) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
672 p[1] = tbl[(temp_name_rand >> 6) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
673 p[2] = tbl[(temp_name_rand >> 12) & 63];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 /* Poor man's congruential RN generator. Replace with ++count
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 for debugging. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
677 temp_name_rand += 25229;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
678 temp_name_rand %= 225307;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
682 if (qxe_stat (data, &ignored) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 /* We want to return only if errno is ENOENT. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 if (errno == ENOENT)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
686 return make_string (data, len + 6);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 /* The error here is dubious, but there is little else we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 can do. The alternatives are to return nil, which is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 as bad as (and in many cases worse than) throwing the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 error, or to ignore the error, which will likely result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 in inflooping. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 report_file_error ("Cannot create temporary name for prefix",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
694 prefix);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 return Qnil; /* not reached */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
701
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 Convert filename NAME to absolute, and canonicalize it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
706 the current buffer's value of `default-directory' is used.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 File name components that are `.' are removed, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 so are file name components followed by `..', along with the `..' itself;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 note that these simplifications are done without checking the resulting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 file names in the file system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 An initial `~/' expands to your home directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 An initial `~USER/' expands to USER's home directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 See also the function `substitute-in-file-name'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 (name, default_directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
717 /* This function can GC. GC-checked 2000-11-18.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
718 This function synched with Emacs 21.0.103. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
719 Ibyte *nm;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
720
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
721 Ibyte *newdir, *p, *o;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 int tlen;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
723 Ibyte *target;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
724 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 int drive = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 int collapse_newdir = 1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
727 /* XEmacs note: This concerns the special '/:' syntax for preventing
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
728 wildcards and such. We don't support this currently but I'm
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
729 keeping the code here in case we do. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
730 int is_escaped = 0;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
731 #endif
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
732 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 struct passwd *pw;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
734 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 int length;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
736 Lisp_Object handler = Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
737 struct gcpro gcpro1, gcpro2, gcpro3;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
738
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
739 /* both of these get set below */
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
740 GCPRO3 (name, default_directory, handler);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 CHECK_STRING (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 handler = Ffind_file_name_handler (name, Qexpand_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 if (!NILP (handler))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
748 RETURN_UNGCPRO (call3_check_string (handler, Qexpand_file_name,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
749 name, default_directory));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 if (NILP (default_directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 default_directory = current_buffer->directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 if (! STRINGP (default_directory))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
755 #ifdef WIN32_NATIVE
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
756 default_directory = build_string ("C:\\");
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
757 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 default_directory = build_string ("/");
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
759 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 if (!NILP (default_directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 if (!NILP (handler))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
765 RETURN_UNGCPRO (call3 (handler, Qexpand_file_name,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
766 name, default_directory));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 o = XSTRING_DATA (default_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 /* Make sure DEFAULT_DIRECTORY is properly expanded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 It would be better to do this down below where we actually use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 default_directory. Unfortunately, calling Fexpand_file_name recursively
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 could invoke GC, and the strings might be relocated. This would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 be annoying because we have pointers into strings lying around
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 that would need adjusting, and people would add new pointers to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 the code and forget to adjust them, resulting in intermittent bugs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 Putting this call here avoids all that crud.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 The EQ test avoids infinite recursion. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 if (! NILP (default_directory) && !EQ (default_directory, name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 /* Save time in some common cases - as long as default_directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 is not relative, it can be canonicalized with name below (if it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 is needed at all) without requiring it to be expanded now. */
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
785 #ifdef WIN32_FILENAMES
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
786 /* Detect Windows file names with drive specifiers. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 /* Detect Windows file names in UNC format. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
790 #endif /* not WIN32_FILENAMES */
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
791 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 /* Detect Unix absolute file names (/... alone is not absolute on
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
793 Windows). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 && ! (IS_DIRECTORY_SEP (o[0]))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
795 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 )
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
797
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
798 default_directory = Fexpand_file_name (default_directory, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 #ifdef FILE_SYSTEM_CASE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 name = FILE_SYSTEM_CASE (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 into name should be safe during all of this, though. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 nm = XSTRING_DATA (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
808 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 /* We will force directory separators to be either all \ or /, so make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 a local copy to modify, even if there ends up being no change. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
811 nm = qxestrcpy (alloca_ibytes (qxestrlen (nm) + 1), nm);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
812
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
813 /* Note if special escape prefix is present, but remove for now. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
814 if (nm[0] == '/' && nm[1] == ':')
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
815 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
816 is_escaped = 1;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
817 nm += 2;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
818 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 /* Find and remove drive specifier if present; this makes nm absolute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 even if the rest of the name appears to be relative. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
823 Ibyte *colon = qxestrrchr (nm, ':');
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 if (colon)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
826 {
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 /* Only recognize colon as part of drive specifier if there is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 single alphabetic character preceding the colon (and if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 character before the drive letter, if present, is a directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 separator); this is to support the remote system syntax used by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 ange-ftp, and the "po:username" syntax for POP mailboxes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 look_again:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 if (nm == colon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 nm++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 else if (IS_DRIVE (colon[-1])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 drive = colon[-1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 nm = colon + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 while (--colon >= nm)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 if (colon[0] == ':')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 goto look_again;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
847 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 /* If we see "c://somedir", we want to strip the first slash after the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 colon when stripping the drive letter. Otherwise, this expands to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 "//somedir". */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 nm++;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
855 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
857 #ifdef WIN32_FILENAMES
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
858 /* Discard any previous drive specifier if nm is now in UNC format. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
859 if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
860 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
861 drive = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
862 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
863 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
864
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 /* If nm is absolute, look for /./ or /../ sequences; if none are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 found, we can probably return right away. We will avoid allocating
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 a new string if name is already fully expanded. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 if (
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 IS_DIRECTORY_SEP (nm[0])
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
870 #ifdef WIN32_NATIVE
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
871 && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 /* If it turns out that the filename we want to return is just a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 suffix of FILENAME, we don't need to go through and edit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 things; we just need to construct a new string using data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 starting at the middle of FILENAME. If we set lose to a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 non-zero value, that means we've discovered that we can't do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 that cool trick. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 int lose = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 p = nm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 while (*p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 /* Since we know the name is absolute, we can assume that each
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 element starts with a "/". */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 /* "." and ".." are hairy. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 if (IS_DIRECTORY_SEP (p[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 && p[1] == '.'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 && (IS_DIRECTORY_SEP (p[2])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 || p[2] == 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 || p[3] == 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 lose = 1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
897 /* We want to replace multiple `/' in a row with a single
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
898 slash. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
899 else if (p > nm
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
900 && IS_DIRECTORY_SEP (p[0])
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
901 && IS_DIRECTORY_SEP (p[1]))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
902 lose = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 if (!lose)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 {
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
907 #ifdef WIN32_FILENAMES
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
908 if (drive || IS_DIRECTORY_SEP (nm[1]))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
910 Ibyte *newnm;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
911
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
912 if (IS_DIRECTORY_SEP (nm[1]))
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
913 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
914 newnm = mswindows_canonicalize_filename (nm);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
915 if (qxestrcmp (newnm, XSTRING_DATA (name)) != 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
916 name = build_intstring (newnm);
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
917 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
918 else
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
919 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
920 /* drive must be set, so this is okay */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
921 newnm = mswindows_canonicalize_filename (nm - 2);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
922 if (qxestrcmp (newnm, XSTRING_DATA (name)) != 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
923 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
924 name = build_intstring (newnm);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
925 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
926 XSTRING_DATA (name)[1] = ':';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
927 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
928 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
929 xfree (newnm);
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
930 RETURN_UNGCPRO (name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
932 #endif /* WIN32_FILENAMES */
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
933 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 if (nm == XSTRING_DATA (name))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
935 RETURN_UNGCPRO (name);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
936 RETURN_UNGCPRO (build_intstring (nm));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
937 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 /* At this point, nm might or might not be an absolute file name. We
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 need to expand ~ or ~user if present, otherwise prefix nm with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 default_directory if nm is not absolute, and finally collapse /./
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 and /foo/../ sequences.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 We set newdir to be the appropriate prefix if one is needed:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 - the relevant user directory if nm starts with ~ or ~user
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 - the specified drive's working dir (DOS/NT only) if nm does not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 start with /
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 - the value of default_directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 Note that these prefixes are not guaranteed to be absolute (except
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 for the working dir of a drive). Therefore, to ensure we always
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 return an absolute name, if the final prefix is not absolute we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 append it to the current working directory. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 newdir = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 if (nm[0] == '~') /* prefix ~ */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 if (IS_DIRECTORY_SEP (nm[1])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 || nm[1] == 0) /* ~ by itself */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
964 Ibyte *homedir = get_home_directory ();
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
965
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
966 if (!homedir)
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
967 newdir = (Ibyte *) "";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
969 newdir = homedir;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 nm++;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
972 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 collapse_newdir = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 else /* ~user/filename */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 DO_NOTHING;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
980 o = (Ibyte *) ALLOCA (p - nm + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
981 memcpy (o, nm, p - nm);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 o [p - nm] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 462
diff changeset
984 /* #### While NT is single-user (for the moment) you still
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 462
diff changeset
985 can have multiple user profiles users defined, each with
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 462
diff changeset
986 its HOME. So maybe possibly we should think about handling
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 462
diff changeset
987 ~user. --ben */
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 462
diff changeset
988 #ifndef WIN32_NATIVE
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
989 #ifdef CYGWIN
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
990 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
991 Ibyte *user;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
992
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
993 if ((user = user_login_name (NULL)) != NULL)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
994 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
995 /* Does the user login name match the ~name? */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
996 if (qxestrcmp (user, o + 1) == 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
997 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
998 newdir = get_home_directory ();
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
999 nm = p;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1000 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1001 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1002 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1003 if (!newdir)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1005 #endif /* CYGWIN */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 occurring in it. (It can call select()). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 slow_down_interrupts ();
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1009 pw = (struct passwd *) qxe_getpwnam (o + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 speed_up_interrupts ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 if (pw)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1013 newdir = (Ibyte *) pw->pw_dir;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 nm = p;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1015 /* FSF: if WIN32_NATIVE, collapse_newdir = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1016 not possible here. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1018 #ifdef CYGWIN
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 #endif
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1021 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 /* If we don't find a user of that name, leave the name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 unchanged; don't move nm forward to p. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1028 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 /* On DOS and Windows, nm is absolute if a drive name was specified;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 use the drive's current directory as the prefix if needed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 if (!newdir && drive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 {
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1033 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 /* Get default directory if needed to make nm absolute. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 if (!IS_DIRECTORY_SEP (nm[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1037 Ibyte *newcwd = mswindows_getdcwd (toupper (drive) - 'A' + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1038 if (newcwd)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1039 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1040 IBYTE_STRING_TO_ALLOCA (newcwd, newdir);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1041 xfree (newcwd);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1042 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1043 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 newdir = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1046 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 if (!newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 /* Either nm starts with /, or drive isn't mounted. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1050 newdir = (Ibyte *) ALLOCA (4);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 newdir[0] = DRIVE_LETTER (drive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 newdir[1] = ':';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 newdir[2] = '/';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 newdir[3] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1057 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 /* Finally, if no prefix has been specified and nm is not absolute,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 then it must be expanded relative to default_directory. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 if (1
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1063 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 /* /... alone is not absolute on DOS and Windows. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 && !IS_DIRECTORY_SEP (nm[0])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1066 #endif
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1067 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 && !newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 newdir = XSTRING_DATA (default_directory);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1073 #ifdef WIN32_FILENAMES
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1074 /* Note if special escape prefix is present, but remove for now. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1075 if (newdir[0] == '/' && newdir[1] == ':')
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1076 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1077 is_escaped = 1;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1078 newdir += 2;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1079 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1080 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1083 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 if (newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 /* First ensure newdir is an absolute name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 if (
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1088 /* Detect Windows file names with drive specifiers. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 ! (IS_DRIVE (newdir[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 /* Detect Windows file names in UNC format. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1093 /* XEmacs: added these two lines: Detect drive spec by itself */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 && ! (IS_DEVICE_SEP (newdir[1]) && newdir[2] == 0)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1095 /* Detect unix format. */
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1096 #ifndef WIN32_NATIVE
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1097 && ! (IS_DIRECTORY_SEP (newdir[0]))
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1098 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 /* Effectively, let newdir be (expand-file-name newdir cwd).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 Because of the admonition against calling expand-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 when we have pointers into lisp strings, we accomplish this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 indirectly by prepending newdir to nm if necessary, and using
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 cwd (or the wd of newdir's drive) as the new newdir. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 drive = newdir[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 newdir += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 if (!IS_DIRECTORY_SEP (nm[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1114 Ibyte *tmp = (Ibyte *) ALLOCA (qxestrlen (newdir) +
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1115 qxestrlen (nm) + 2);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1116 file_name_as_directory (tmp, newdir);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1117 qxestrcat (tmp, nm);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 nm = tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 if (drive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 {
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1122 #ifdef WIN32_NATIVE
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1123 Ibyte *newcwd = mswindows_getdcwd (toupper (drive) - 'A' + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1124 if (newcwd)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1125 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1126 IBYTE_STRING_TO_ALLOCA (newcwd, newdir);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1127 xfree (newcwd);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1128 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1129 else
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1130 #endif
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1131 IBYTE_STRING_TO_ALLOCA ((Ibyte *) "/", newdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 else
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1134 IBYTE_STRING_TO_ALLOCA (get_initial_directory (0, 0), newdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 /* Strip off drive name from prefix, if present. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 drive = newdir[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 newdir += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 /* Keep only a prefix from newdir if nm starts with slash
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1145 (//server/share for UNC, nothing otherwise). */
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1146 if (IS_DIRECTORY_SEP (nm[0])
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1147 #ifndef WIN32_NATIVE
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1148 && IS_DIRECTORY_SEP (nm[1])
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1149 #endif
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1150 && collapse_newdir)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 {
664
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 657
diff changeset
1154 newdir =
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1155 (Ibyte *)
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1156 qxestrcpy ((Ibyte *) ALLOCA (qxestrlen (newdir) + 1),
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1157 newdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 p = newdir + 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 *p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 else
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1165 newdir = (Ibyte *) "";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1168 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 if (newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 /* Get rid of any slash at the end of newdir, unless newdir is
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1173 just / or // (an incomplete UNC name). */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1174 length = qxestrlen (newdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1176 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1181 Ibyte *temp = (Ibyte *) ALLOCA (length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 memcpy (temp, newdir, length - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 temp[length - 1] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 newdir = temp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 tlen = length + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 tlen = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 /* Now concatenate the directory and name to new space in the stack frame */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1192 tlen += qxestrlen (nm) + 1;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1193 #ifdef WIN32_FILENAMES
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1194 /* Reserve space for drive specifier and escape prefix, since either
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1195 or both may need to be inserted. (The Microsoft x86 compiler
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 produces incorrect code if the following two lines are combined.) */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1197 target = (Ibyte *) ALLOCA (tlen + 4);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1198 target += 4;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1199 #else /* not WIN32_FILENAMES */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1200 target = (Ibyte *) ALLOCA (tlen);
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1201 #endif /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 *target = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 if (newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1207 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1208 #ifdef WIN32_FILENAMES
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1209 /* If newdir is effectively "C:/", then the drive letter will have
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1210 been stripped and newdir will be "/". Concatenating with an
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1211 absolute directory in nm produces "//", which will then be
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1212 incorrectly treated as a network share. Ignore newdir in
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1213 this case (keeping the drive letter). */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1214 if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1215 && newdir[1] == '\0'))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1216 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1217 qxestrcpy (target, newdir);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1218 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1220 file_name_as_directory (target, newdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1223 qxestrcat (target, nm);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1227 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1228 appear. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 p = target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 o = target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 while (*p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 if (!IS_DIRECTORY_SEP (*p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 *o++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 else if (IS_DIRECTORY_SEP (p[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 && p[1] == '.'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 && (IS_DIRECTORY_SEP (p[2])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 || p[2] == 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 /* If "/." is the entire filename, keep the "/". Otherwise,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 just delete the whole "/.". */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 if (o == target && p[2] == '\0')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 *o++ = *p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 p += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 /* `/../' is the "superroot" on certain file systems. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 && o != target
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 /* Keep initial / only if this is the whole name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 ++o;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 p += 3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1262 else if (p > target
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1263 && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1264 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1265 /* Collapse multiple `/' in a row. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1266 *o++ = *p++;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1267 while (IS_DIRECTORY_SEP (*p))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1268 ++p;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1269 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 *o++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1276 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 /* At last, set drive name, except for network file name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 if (drive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 target -= 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 target[0] = DRIVE_LETTER (drive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 target[1] = ':';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1284 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1289 #endif
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1290 /* Reinsert the escape prefix if required. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1291 if (is_escaped)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1292 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1293 target -= 2;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1294 target[0] = '/';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1295 target[1] = ':';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1296 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1297
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1298 *o = '\0';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1299
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1300 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1301 Ibyte *newtarget = mswindows_canonicalize_filename (target);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1302 Lisp_Object result = build_intstring (newtarget);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1303 xfree (newtarget);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1304
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1305 RETURN_UNGCPRO (result);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1306 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1307 #else /* not WIN32_FILENAMES */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1308 RETURN_UNGCPRO (make_string (target, o - target));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1309 #endif /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1313 Return the canonical name of FILENAME.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1314 Second arg DEFAULT is directory to start with if FILENAME is relative
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 (does not start with slash); if DEFAULT is nil or missing,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1316 the current buffer's value of `default-directory' is used.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 No component of the resulting pathname will be a symbolic link, as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 in the realpath() function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 (filename, default_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1322 /* This function can GC. GC checked 2000-07-28 ben. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 Lisp_Object expanded_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 expanded_name = Fexpand_file_name (filename, default_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 if (!STRINGP (expanded_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 GCPRO1 (expanded_name);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1334
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1335 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1336 Lisp_Object handler =
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1337 Ffind_file_name_handler (expanded_name, Qfile_truename);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1338
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1339 if (!NILP (handler))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1340 RETURN_UNGCPRO
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1341 (call2_check_string (handler, Qfile_truename, expanded_name));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1342 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1345 Ibyte resolved_path[PATH_MAX];
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1346 Bytecount elen = XSTRING_LENGTH (expanded_name);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1347 Ibyte *path;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1348 Ibyte *p;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1349
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1350 LISP_STRING_TO_ALLOCA (expanded_name, path);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 p = path;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1352
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 /* Try doing it all at once. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1354 if (!qxe_realpath (path, resolved_path))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 /* Didn't resolve it -- have to do it one component at a time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 /* "realpath" is a typically useless, stupid un*x piece of crap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 It claims to return a useful value in the "error" case, but since
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 there is no indication provided of how far along the pathname
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 the function went before erring, there is no way to use the
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1361 partial result returned. What a piece of junk.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1362
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1363 The above comment refers to historical versions of
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1364 realpath(). The Unix98 specs state:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1365
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1366 "On successful completion, realpath() returns a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1367 pointer to the resolved name. Otherwise, realpath()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1368 returns a null pointer and sets errno to indicate the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1369 error, and the contents of the buffer pointed to by
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1370 resolved_name are undefined."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1371
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1372 Since we depend on undocumented semantics of various system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1373 realpath()s, we just use our own version in realpath.c. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1376 Ibyte *pos;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1377
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1378 #ifdef WIN32_FILENAMES
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1379 if (IS_DRIVE (p[0]) && IS_DEVICE_SEP (p[1])
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1380 && IS_DIRECTORY_SEP (p[2]))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1381 /* don't test c: on windows */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1382 p = p+2;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1383 else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1384 /* start after // */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1385 p = p+1;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1386 #endif
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1387 for (pos = p + 1; pos < path + elen; pos++)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1388 if (IS_DIRECTORY_SEP (*pos))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1389 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1390 *(p = pos) = 0;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1391 break;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1392 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1393 if (p != pos)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1394 p = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1396 if (qxe_realpath (path, resolved_path))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 if (p)
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1399 *p = DIRECTORY_SEP;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 else if (errno == ENOENT || errno == EACCES)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 /* Failed on this component. Just tack on the rest of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 the string and we are done. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1408 int rlen = qxestrlen (resolved_path);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 /* "On failure, it returns NULL, sets errno to indicate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 the error, and places in resolved_path the absolute pathname
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 of the path component which could not be resolved." */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1413
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1414 if (p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 int plen = elen - (p - path);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1418 if (rlen > 1 && IS_DIRECTORY_SEP (resolved_path[rlen - 1]))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 rlen = rlen - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 if (plen + rlen + 1 > countof (resolved_path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 goto toolong;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1424 resolved_path[rlen] = DIRECTORY_SEP;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1435 Lisp_Object resolved_name;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1436 int rlen = qxestrlen (resolved_path);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1437 if (elen > 0 && IS_DIRECTORY_SEP (string_byte (expanded_name, elen - 1))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1438 && !(rlen > 0 && IS_DIRECTORY_SEP (resolved_path[rlen - 1])))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 if (rlen + 1 > countof (resolved_path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 goto toolong;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1442 resolved_path[rlen++] = DIRECTORY_SEP;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1443 resolved_path[rlen] = '\0';
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1445 resolved_name = make_string (resolved_path, rlen);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1446 RETURN_UNGCPRO (resolved_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 toolong:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 errno = ENAMETOOLONG;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 lose:
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1453 report_file_error ("Finding truename", expanded_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1455 RETURN_UNGCPRO (Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 Substitute environment variables referred to in FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 `$FOO' where FOO is an environment variable name means to substitute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 the value of that variable. The variable name should be terminated
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1463 with a character, not a letter, digit or underscore; otherwise, enclose
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 the entire variable name in braces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 If `/~' appears, all of FILENAME through that `/' is discarded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1467 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1469 /* This function can GC. GC checked 2000-07-28 ben. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1470 Ibyte *nm;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1471
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1472 Ibyte *s, *p, *o, *x, *endp;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1473 Ibyte *target = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 int total = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 int substituted = 0;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1476 Ibyte *xnm;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1479 CHECK_STRING (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1483 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 return call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1486 filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1487
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1488 nm = XSTRING_DATA (filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1489 endp = nm + XSTRING_LENGTH (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 /* If /~ or // appears, discard everything through first slash. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 for (p = nm; p != endp; p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 if ((p[0] == '~'
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1496 #if defined (WIN32_FILENAMES)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
1497 /* // at start of file name is meaningful in WindowsNT systems */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1499 #else /* not (WIN32_FILENAMES) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 || IS_DIRECTORY_SEP (p[0])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1501 #endif /* not (WIN32_FILENAMES) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 && p != nm
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 && (IS_DIRECTORY_SEP (p[-1])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 nm = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 substituted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1509 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 /* see comment in expand-file-name about drive specifiers */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 else if (IS_DRIVE (p[0]) && p[1] == ':'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 && p > nm && IS_DIRECTORY_SEP (p[-1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 nm = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 substituted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1517 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 /* See if any variables are substituted into the string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 and find the total length of their values in `total' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 for (p = nm; p != endp;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 if (*p != '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 if (p == endp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 goto badsubst;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 else if (*p == '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 /* "$$" means a single "$" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 total -= 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 substituted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 else if (*p == '{')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 o = ++p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 while (p != endp && *p != '}') p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 if (*p != '}') goto missingclose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 s = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 o = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 while (p != endp && (isalnum (*p) || *p == '_')) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 s = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 /* Copy out the variable name */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1554 target = (Ibyte *) ALLOCA (s - o + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1555 qxestrncpy (target, o, s - o);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 target[s - o] = 0;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1557 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 strupr (target); /* $home == $HOME etc. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1559 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 /* Get variable value */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1562 o = egetenv ((CIbyte *) target);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 if (!o) goto badvar;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1564 total += qxestrlen (o);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 substituted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 if (!substituted)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1569 return filename;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1570
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1571 /* If substitution required, recopy the filename and do it */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 /* Make space in stack frame for the new copy */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1573 xnm = (Ibyte *) ALLOCA (XSTRING_LENGTH (filename) + total + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 x = xnm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 /* Copy the rest of the name through, replacing $ constructs with values */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 for (p = nm; *p;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 if (*p != '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 *x++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 if (p == endp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 goto badsubst;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 else if (*p == '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 *x++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 else if (*p == '{')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 o = ++p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 while (p != endp && *p != '}') p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 if (*p != '}') goto missingclose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 s = p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 o = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 while (p != endp && (isalnum (*p) || *p == '_')) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 s = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 /* Copy out the variable name */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1605 target = (Ibyte *) ALLOCA (s - o + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1606 qxestrncpy (target, o, s - o);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 target[s - o] = 0;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1608 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 strupr (target); /* $home == $HOME etc. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1610 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 /* Get variable value */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1613 o = egetenv ((CIbyte *) target);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 if (!o)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 goto badvar;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1617 qxestrcpy (x, o);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1618 x += qxestrlen (o);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 *x = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 /* If /~ or // appears, discard everything through first slash. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 for (p = xnm; p != x; p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 if ((p[0] == '~'
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1627 #if defined (WIN32_FILENAMES)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1629 #else /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 || IS_DIRECTORY_SEP (p[0])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1631 #endif /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 /* don't do p[-1] if that would go off the beginning --jwz */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 xnm = p;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1636 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 else if (IS_DRIVE (p[0]) && p[1] == ':'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 && p > nm && IS_DIRECTORY_SEP (p[-1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 xnm = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 return make_string (xnm, x - xnm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 badsubst:
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1645 syntax_error ("Bad format environment-variable substitution", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 missingclose:
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1647 syntax_error ("Missing \"}\" in environment-variable substitution",
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1648 filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 badvar:
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1650 syntax_error_2 ("Substituting nonexistent environment variable",
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1651 filename, build_intstring (target));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
1653 RETURN_NOT_REACHED (Qnil)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 /* A slightly faster and more convenient way to get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 (directory-file-name (expand-file-name FOO)). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1662 /* This function can call Lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 abspath = Fexpand_file_name (filename, defdir);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 /* Remove final slash, if any (unless path is root).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 stat behaves differently depending! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 if (XSTRING_LENGTH (abspath) > 1
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1671 && IS_DIRECTORY_SEP (string_byte (abspath, XSTRING_LENGTH (abspath) - 1))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1672 && !IS_DEVICE_SEP (string_byte (abspath, XSTRING_LENGTH (abspath) - 2)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 /* We cannot take shortcuts; they might be wrong for magic file names. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 abspath = Fdirectory_file_name (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 return abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 /* Signal an error if the file ABSNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 If INTERACTIVE is nonzero, ask the user whether to proceed,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 and bypass the error if the user says to go ahead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 QUERYSTRING is a name for the action that is being considered
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 to alter the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 *STATPTR is used to store the stat information if the file exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 If the file does not exist, STATPTR->st_mode is set to 0. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 static void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1688 barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 int interactive, struct stat *statptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1691 /* This function can call Lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 struct stat statbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 /* stat is a good way to tell whether the file exists,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 regardless of what access permissions it has. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1696 if (qxe_stat (XSTRING_DATA (absname), &statbuf) >= 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 if (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 Lisp_Object prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1705 prompt =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1706 emacs_sprintf_string
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1707 (CGETTEXT ("File %s already exists; %s anyway? "),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1708 XSTRING_DATA (absname), CGETTEXT (querystring));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 GCPRO1 (prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 tem = call1 (Qyes_or_no_p, prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 tem = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 if (NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 Fsignal (Qfile_already_exists,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1719 list2 (build_msg_string ("File already exists"),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 absname));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 if (statptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722 *statptr = statbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 if (statptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 statptr->st_mode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 DEFUN ("copy-file", Fcopy_file, 2, 4,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 "fCopy file: \nFCopy %s to file: \np\nP", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1734 Copy FILENAME to NEWNAME. Both args must be strings.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 Signals a `file-already-exists' error if file NEWNAME already exists,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 A number as third arg means request confirmation if NEWNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 This is what happens in interactive use with M-x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 Fourth arg KEEP-TIME non-nil means give the new file the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 last-modified time as the old one. (This works on only some systems.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 A prefix arg makes KEEP-TIME non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 (filename, newname, ok_if_already_exists, keep_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1745 /* This function can call Lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 int ifd, ofd, n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 char buf[16 * 1024];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 struct stat st, out_st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 /* Lisp_Object args[6]; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 int input_file_statable_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 GCPRO2 (filename, newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 CHECK_STRING (newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 newname = Fexpand_file_name (newname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 /* If the input file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 handler = Ffind_file_name_handler (filename, Qcopy_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 /* Likewise for output file name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 handler = Ffind_file_name_handler (newname, Qcopy_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 return call5 (handler, Qcopy_file, filename, newname,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 ok_if_already_exists, keep_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 /* When second argument is a directory, copy the file into it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 if (!NILP (Ffile_directory_p (newname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 Lisp_Object args[3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 int i = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 args[0] = newname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 args[1] = Qnil; args[2] = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 NGCPRO1 (*args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 ngcpro1.nvars = 3;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1787 if (!IS_DIRECTORY_SEP (string_byte (newname,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1788 XSTRING_LENGTH (newname) - 1)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1789
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1790 args[i++] = Fchar_to_string (Vdirectory_sep_char);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 args[i++] = Ffile_name_nondirectory (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 newname = Fconcat (i, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 barf_or_query_if_file_exists (newname, "copy to it",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 INTP (ok_if_already_exists), &out_st);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1800 else if (qxe_stat (XSTRING_DATA (newname), &out_st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 out_st.st_mode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1803 ifd = qxe_interruptible_open (XSTRING_DATA (filename),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1804 O_RDONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 if (ifd < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1806 report_file_error ("Opening input file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 record_unwind_protect (close_file_unwind, make_int (ifd));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 /* We can only copy regular files and symbolic links. Other files are not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 copyable by us. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1812 input_file_statable_p = (qxe_fstat (ifd, &st) >= 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1814 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 if (out_st.st_mode != 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 errno = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 report_file_error ("Input and output files are the same",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1820 list3 (Qunbound, filename, newname));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 #if defined (S_ISREG) && defined (S_ISLNK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 if (input_file_statable_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 if (!(S_ISREG (st.st_mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 #ifdef S_ISCHR
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 && !(S_ISCHR (st.st_mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 && !(S_ISLNK (st.st_mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 #if defined (EISDIR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 /* Get a better looking error message. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 errno = EISDIR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 #endif /* EISDIR */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1838 report_file_error ("Non-regular file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 #endif /* S_ISREG && S_ISLNK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1843 ofd = qxe_open (XSTRING_DATA (newname),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1844 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 if (ofd < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1846 report_file_error ("Opening output file", newname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 record_unwind_protect (close_file_unwind, ofd_locative);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 if (write_allowing_quit (ofd, buf, n) != n)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1856 report_file_error ("I/O error", newname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 /* Closing the output clobbers the file times on some systems. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1860 if (retry_close (ofd) < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1861 report_file_error ("I/O error", newname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 if (input_file_statable_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1865 if (!NILP (keep_time))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1866 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1867 EMACS_TIME atime, mtime;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1868 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1869 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
592
4f6ba8f1fb3d [xemacs-hg @ 2001-05-31 12:03:37 by adrian]
adrian
parents: 563
diff changeset
1870 if (set_file_times (newname, atime, mtime))
4f6ba8f1fb3d [xemacs-hg @ 2001-05-31 12:03:37 by adrian]
adrian
parents: 563
diff changeset
1871 report_file_error ("I/O error", list1 (newname));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1872 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1873 qxe_chmod (XSTRING_DATA (newname), st.st_mode & 07777);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 /* We'll close it by hand */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 XCAR (ofd_locative) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 /* Close ifd */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1880 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 Create a directory. One argument, a file name string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 (dirname_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 struct gcpro gcpro1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1895 DECLARE_EISTRING (dir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 CHECK_STRING (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 dirname_ = Fexpand_file_name (dirname_, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 GCPRO1 (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 return (call2 (handler, Qmake_directory_internal, dirname_));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1906 eicpy_lstr (dir, dirname_);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1907 if (eigetch_char (dir, eicharlen (dir) - 1) == '/')
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1908 eidel (dir, eilen (dir) - 1, -1, 1, -1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1909
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1910 if (qxe_mkdir (eidata (dir), 0777) != 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1911 report_file_error ("Creating directory", dirname_);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 Delete a directory. One argument, a file name or directory name string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 (dirname_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 CHECK_STRING (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 GCPRO1 (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 dirname_ = Fexpand_file_name (dirname_, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 dirname_ = Fdirectory_file_name (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 return (call2 (handler, Qdelete_directory, dirname_));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1936 if (qxe_rmdir (XSTRING_DATA (dirname_)) != 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1937 report_file_error ("Removing directory", dirname_);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1943 Delete the file named FILENAME (a string).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1944 If FILENAME has multiple names, it continues to exist with the other names.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 GCPRO1 (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 handler = Ffind_file_name_handler (filename, Qdelete_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 return call2 (handler, Qdelete_file, filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1961 if (0 > qxe_unlink (XSTRING_DATA (filename)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1962 report_file_error ("Removing old name", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 internal_delete_file_1 (Lisp_Object ignore, Lisp_Object ignore2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 internal_delete_file (Lisp_Object filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 internal_delete_file_1, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 DEFUN ("rename-file", Frename_file, 2, 3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 "fRename file: \nFRename %s to file: \np", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1984 Rename FILENAME as NEWNAME. Both args must be strings.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1985 If file has names other than FILENAME, it continues to have those names.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 Signals a `file-already-exists' error if a file NEWNAME already exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 A number as third arg means request confirmation if NEWNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 This is what happens in interactive use with M-x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 (filename, newname, ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 GCPRO2 (filename, newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 CHECK_STRING (newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 newname = Fexpand_file_name (newname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 handler = Ffind_file_name_handler (filename, Qrename_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 handler = Ffind_file_name_handler (newname, Qrename_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 return call4 (handler, Qrename_file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 filename, newname, ok_if_already_exists);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 /* When second argument is a directory, rename the file into it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 if (!NILP (Ffile_directory_p (newname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 Lisp_Object args[3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 int i = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 args[0] = newname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 args[1] = Qnil; args[2] = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 NGCPRO1 (*args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 ngcpro1.nvars = 3;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2028 if (string_byte (newname, XSTRING_LENGTH (newname) - 1) != '/')
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 args[i++] = build_string ("/");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 args[i++] = Ffile_name_nondirectory (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 newname = Fconcat (i, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 barf_or_query_if_file_exists (newname, "rename to it",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 INTP (ok_if_already_exists), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2040 /* We have configure check for rename() and emulate using
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2041 link()/unlink() if necessary. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2042 if (0 > qxe_rename (XSTRING_DATA (filename), XSTRING_DATA (newname)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 if (errno == EXDEV)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 Fcopy_file (filename, newname,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 /* We have already prompted if it was an integer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 so don't have copy-file prompt again. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 (NILP (ok_if_already_exists) ? Qnil : Qt),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 Fdelete_file (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2055 report_file_error ("Renaming", list3 (Qunbound, filename, newname));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 "fAdd name to file: \nFName to add to %s: \np", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2064 Give FILENAME additional name NEWNAME. Both args must be strings.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 Signals a `file-already-exists' error if a file NEWNAME already exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 A number as third arg means request confirmation if NEWNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 This is what happens in interactive use with M-x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 (filename, newname, ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 GCPRO2 (filename, newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 CHECK_STRING (newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 newname = Fexpand_file_name (newname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 newname, ok_if_already_exists));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 /* If the new name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 newname, ok_if_already_exists));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 barf_or_query_if_file_exists (newname, "make it a new name",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 INTP (ok_if_already_exists), 0);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2100 /* #### Emacs 20.6 contains an implementation of link() in w32.c.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2101 Need to port. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2102 #ifndef HAVE_LINK
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2103 signal_error_2 (Qunimplemented, "Adding new name", filename, newname);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2104 #else /* HAVE_LINK */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2105 qxe_unlink (XSTRING_DATA (newname));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2106 if (0 > qxe_link (XSTRING_DATA (filename), XSTRING_DATA (newname)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 report_file_error ("Adding new name",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2109 list3 (Qunbound, filename, newname));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2111 #endif /* HAVE_LINK */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 Signals a `file-already-exists' error if a file LINKNAME already exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 A number as third arg means request confirmation if LINKNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 This happens for interactive use with M-x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 (filename, linkname, ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 /* This function can GC. GC checked 1997.06.04. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2128 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 GCPRO2 (filename, linkname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 CHECK_STRING (linkname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 /* If the link target has a ~, we must expand it to get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 a truly valid file name. Otherwise, do not expand;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 we want to permit links to relative file names. */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2138 if (string_byte (filename, 0) == '~')
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 linkname = Fexpand_file_name (linkname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 ok_if_already_exists));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 /* If the new link name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 linkname, ok_if_already_exists));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2156 #ifdef HAVE_SYMLINK
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 barf_or_query_if_file_exists (linkname, "make it a link",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 INTP (ok_if_already_exists), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2162 qxe_unlink (XSTRING_DATA (linkname));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2163 if (0 > qxe_symlink (XSTRING_DATA (filename),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2164 XSTRING_DATA (linkname)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 report_file_error ("Making symbolic link",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2167 list3 (Qunbound, filename, linkname));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2169 #endif
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2170
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 #ifdef HPUX_NET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 Open a network connection to PATH using LOGIN as the login string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 (path, login))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 int netresult;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2183 const char *path_ext;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2184 const char *login_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 CHECK_STRING (path);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187 CHECK_STRING (login);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 /* netunam, being a strange-o system call only used once, is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 encapsulated. */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2191
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2192 LISP_STRING_TO_EXTERNAL (path, path_ext, Qfile_name);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2193 LISP_STRING_TO_EXTERNAL (login, login_ext, Qnative);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2194
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2195 netresult = netunam (path_ext, login_ext);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2196
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2197 return netresult == -1 ? Qnil : Qt;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 #endif /* HPUX_NET */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 Return t if file FILENAME specifies an absolute path name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 On Unix, this is a name starting with a `/' or a `~'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 /* This function does not GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2208 Ibyte *ptr;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 ptr = XSTRING_DATA (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
2213 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 ) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 /* Return nonzero if file FILENAME exists and can be executed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 static int
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2222 check_executable (Lisp_Object filename)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2224 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225 struct stat st;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2226 if (qxe_stat (XSTRING_DATA (filename), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 return ((st.st_mode & S_IEXEC) != 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2229 #else /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 #ifdef HAVE_EACCESS
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2231 return qxe_eaccess (XSTRING_DATA (filename), X_OK) >= 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 /* Access isn't quite right because it uses the real uid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 and we really want to test with the effective uid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 But Unix doesn't give us a right way to do it. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2236 return qxe_access (XSTRING_DATA (filename), X_OK) >= 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 #endif /* HAVE_EACCESS */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2238 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 /* Return nonzero if file FILENAME exists and can be written. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 static int
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2244 check_writable (const Ibyte *filename)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 #ifdef HAVE_EACCESS
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2247 return (qxe_eaccess (filename, W_OK) >= 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 /* Access isn't quite right because it uses the real uid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 and we really want to test with the effective uid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 But Unix doesn't give us a right way to do it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 Opening with O_WRONLY could work for an ordinary file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 but would lose for directories. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2254 return (qxe_access (filename, W_OK) >= 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 Return t if file FILENAME exists. (This does not mean you can read it.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 See also `file-readable-p' and `file-attributes'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2264 /* This function can call lisp; GC checked 2000-07-11 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 struct stat statbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271 abspath = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 return call2 (handler, Qfile_exists_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2281 return qxe_stat (XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285 Return t if FILENAME can be executed by you.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 For a directory, this means you can access files in that directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2291 /* This function can GC. GC checked 07-11-2000 ben. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 abspath = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 return call2 (handler, Qfile_executable_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2307 return check_executable (abspath) ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311 Return t if file FILENAME exists and you can read it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 See also `file-exists-p' and `file-attributes'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 Lisp_Object abspath = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 abspath = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
2331 #if defined(WIN32_FILENAMES)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 /* Under MS-DOS and Windows, open does not work for directories. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 UNGCPRO;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2334 if (qxe_access (XSTRING_DATA (abspath), 0) == 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337 return Qnil;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
2338 #else /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2340 int desc = qxe_interruptible_open (XSTRING_DATA (abspath),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2341 O_RDONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 if (desc < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344 return Qnil;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2345 retry_close (desc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
2348 #endif /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 on the RT/PC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 Return t if file FILENAME can be written or created by you.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 Lisp_Object abspath, dir;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 struct stat statbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 abspath = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 return call2 (handler, Qfile_writable_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2375 if (qxe_stat (XSTRING_DATA (abspath), &statbuf) >= 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2376 return (check_writable (XSTRING_DATA (abspath))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 ? Qt : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 dir = Ffile_name_directory (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 UNGCPRO;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2383 return (check_writable (!NILP (dir) ? XSTRING_DATA (dir) : (Ibyte *) "")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 ? Qt : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 Return non-nil if file FILENAME is the name of a symbolic link.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 The value is the name of the file to which it is linked.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 Otherwise returns nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 /* This function can GC. GC checked 1997.04.10. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2395 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2396 #ifdef HAVE_READLINK
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2397 Ibyte *buf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 int bufsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 int valsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 Lisp_Object val;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2401 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 GCPRO1 (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414 return call2 (handler, Qfile_symlink_p, filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2416 #ifdef HAVE_READLINK
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 bufsize = 100;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2419 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2420 buf = xnew_array_and_zero (Ibyte, bufsize);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2421 valsize = qxe_readlink (XSTRING_DATA (filename),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2422 buf, bufsize);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423 if (valsize < bufsize) break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 /* Buffer was not long enough */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 xfree (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426 bufsize *= 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428 if (valsize == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 xfree (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2433 val = make_string (buf, valsize);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434 xfree (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2435 return val;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2436 #else /* not HAVE_READLINK */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 return Qnil;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2438 #endif /* not HAVE_READLINK */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442 Return t if file FILENAME is the name of a directory as a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 A directory name spec may be given instead; then the value is t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 if the directory so specified exists and really is a directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455 abspath = expand_and_dir_to_file (filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456 current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 return call2 (handler, Qfile_directory_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2467 if (qxe_stat (XSTRING_DATA (abspath), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 Return t if file FILENAME is the name of a directory as a file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 and files in that directory can be opened by you. In order to use a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 directory as a buffer's current directory, this predicate must return true.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 A directory name spec may be given instead; then the value is t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 if the directory so specified exists and really is a readable and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 searchable directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 return call2 (handler, Qfile_accessible_directory_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2492 #if !defined(WIN32_NATIVE)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 if (NILP (Ffile_directory_p (filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 return (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 return Ffile_executable_p (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 int tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 /* It's an unlikely combination, but yes we really do need to gcpro:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 Suppose that file-accessible-directory-p has no handler, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 file-directory-p does have a handler; this handler causes a GC which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 relocates the string in `filename'; and finally file-directory-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505 returns non-nil. Then we would end up passing a garbaged string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 to file-executable-p. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507 GCPRO1 (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 tem = (NILP (Ffile_directory_p (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 || NILP (Ffile_executable_p (filename)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 return tem ? Qnil : Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2513 #endif /* !defined(WIN32_NATIVE) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 Return t if file FILENAME is the name of a regular file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 This is the sort of file that holds an ordinary stream of data bytes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 return call2 (handler, Qfile_regular_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2540 if (qxe_stat (XSTRING_DATA (abspath), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2545 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2546 Return mode bits of file named FILENAME, as an integer.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557 abspath = expand_and_dir_to_file (filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558 current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2561 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2562 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 handler = Ffind_file_name_handler (abspath, Qfile_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2566 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2567 return call2 (handler, Qfile_modes, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2569 if (qxe_stat (XSTRING_DATA (abspath), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2571 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2572 #if 0
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2573 #ifdef WIN32_NATIVE
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2574 if (check_executable (abspath))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2575 st.st_mode |= S_IEXEC;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2576 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579 return make_int (st.st_mode & 07777);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2581
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2582 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2583 Set mode bits of file named FILENAME to MODE (an integer).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584 Only the 12 low bits of MODE are used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 (filename, mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2588 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2590 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2592
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2593 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2594 abspath = Fexpand_file_name (filename, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2595 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2597 CHECK_INT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2598
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2599 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2600 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2601 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2602 handler = Ffind_file_name_handler (abspath, Qset_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2603 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2604 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2605 return call3 (handler, Qset_file_modes, abspath, mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2606
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2607 if (qxe_chmod (XSTRING_DATA (abspath), XINT (mode)) < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2608 report_file_error ("Doing chmod", abspath);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2609
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2610 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2611 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2612
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2613 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2614 Set the file permission bits for newly created files.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2615 The argument MODE should be an integer; if a bit in MODE is 1,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2616 subsequently created files will not have the permission corresponding
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2617 to that bit enabled. Only the low 9 bits are used.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2618 This setting is inherited by subprocesses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2619 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2620 (mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2621 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2622 CHECK_INT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2623
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2624 umask ((~ XINT (mode)) & 0777);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2625
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2626 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2627 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2628
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2629 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2630 Return the default file protection for created files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2631 The umask value determines which permissions are enabled in newly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2632 created files. If a permission's bit in the umask is 1, subsequently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2633 created files will not have that permission enabled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2634 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2635 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2636 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2637 int mode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2638
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2639 mode = umask (0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2640 umask (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2641
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2642 return make_int ((~ mode) & 0777);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2643 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2645 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2646 Tell Unix to finish all pending disk updates.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2647 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2650 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651 sync ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2654 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2657 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658 Return t if file FILE1 is newer than file FILE2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 If FILE1 does not exist, the answer is nil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 otherwise, if FILE2 does not exist, the answer is t.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2662 (file1, file2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2663 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 Lisp_Object abspath1, abspath2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2667 int mtime1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 CHECK_STRING (file1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 CHECK_STRING (file2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 abspath1 = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675 abspath2 = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 GCPRO3 (abspath1, abspath2, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2679 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2687 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2688 return call3 (handler, Qfile_newer_than_file_p, abspath1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2689 abspath2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2690
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2691 if (qxe_stat (XSTRING_DATA (abspath1), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 mtime1 = st.st_mtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2696 if (qxe_stat (XSTRING_DATA (abspath2), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699 return (mtime1 > st.st_mtime) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2700 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2702
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2703 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704 /* #define READ_BUF_SIZE (2 << 16) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705 #define READ_BUF_SIZE (1 << 15)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 1, 7, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709 Insert contents of file FILENAME after point; no coding-system frobbing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 This function is identical to `insert-file-contents' except for the
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2711 handling of the CODESYS and USED-CODESYS arguments.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2712
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2713 The file is decoded according to CODESYS; if omitted, no conversion
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2714 happens. If USED-CODESYS is non-nil, it should be a symbol, and the actual
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2715 coding system that was used for the decoding is stored into it. It will in
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2716 general be different from CODESYS if CODESYS specifies automatic encoding
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2717 detection or end-of-line detection.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2719 Currently START and END refer to byte positions (as opposed to character
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2720 positions), even in Mule and under MS Windows. (Fixing this, particularly
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2721 under Mule, is very difficult.)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2722 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2723 (filename, visit, start, end, replace, codesys, used_codesys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2724 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2725 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2726 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2727 int fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2728 int saverrno = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2729 Charcount inserted = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730 int speccount;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 Lisp_Object handler = Qnil, val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2733 int total;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2734 Ibyte read_buf[READ_BUF_SIZE];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 int mc_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736 struct buffer *buf = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2737 Lisp_Object curbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2738 int not_regular = 0;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2739 int do_speedy_insert =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2740 coding_system_is_binary (Fget_coding_system (codesys));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2742 if (buf->base_buffer && ! NILP (visit))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2743 invalid_operation ("Cannot do file visiting in an indirect buffer", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2744
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2745 /* No need to call Fbarf_if_buffer_read_only() here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2746 That's called in begin_multiple_change() or wherever. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2747
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2748 val = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2749
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2750 /* #### dmoore - should probably check in various places to see if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751 curbuf was killed and if so signal an error? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2752
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
2753 curbuf = wrap_buffer (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755 GCPRO5 (filename, val, visit, handler, curbuf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2756
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757 mc_count = (NILP (replace)) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2758 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2759 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2760
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2761 speccount = specpdl_depth (); /* begin_multiple_change also adds
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2762 an unwind_protect */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2763
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2765
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2767 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2768 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2769 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2770 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2771 val = call6 (handler, Qinsert_file_contents, filename,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2772 visit, start, end, replace);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773 goto handled;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2774 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2775
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 if (!NILP (used_codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777 CHECK_SYMBOL (used_codesys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2778
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2779 if ( (!NILP (start) || !NILP (end)) && !NILP (visit) )
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2780 invalid_operation ("Attempt to visit less than an entire file", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782 fd = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2783
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2784 if (qxe_stat (XSTRING_DATA (filename), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2785 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2786 if (fd >= 0) retry_close (fd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787 badopen:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2788 if (NILP (visit))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2789 report_file_error ("Opening input file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790 st.st_mtime = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791 goto notfound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2794 #ifdef S_IFREG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795 /* Signal an error if we are accessing a non-regular file, with
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2796 REPLACE, START or END being non-nil. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 if (!S_ISREG (st.st_mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799 not_regular = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 if (!NILP (visit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2802 goto notfound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2803
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2804 if (!NILP (replace) || !NILP (start) || !NILP (end))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2806 end_multiple_change (buf, mc_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2807
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2808 RETURN_UNGCPRO
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2809 (Fsignal (Qfile_error,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2810 list2 (build_msg_string("not a regular file"),
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2811 filename)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2812 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2813 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814 #endif /* S_IFREG */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2815
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2816 if (!NILP (start))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2817 CHECK_INT (start);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2818 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2819 start = Qzero;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2820
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 if (!NILP (end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 CHECK_INT (end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 if (fd < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2826 if ((fd = qxe_interruptible_open (XSTRING_DATA (filename),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2827 O_RDONLY | OPEN_BINARY, 0)) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828 goto badopen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2831 /* Replacement should preserve point as it preserves markers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2832 if (!NILP (replace))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2833 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835 record_unwind_protect (close_file_unwind, make_int (fd));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 /* Supposedly happens on VMS. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838 if (st.st_size < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2839 signal_error (Qfile_error, "File size is negative", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2840
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2841 if (NILP (end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843 if (!not_regular)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2844 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2845 end = make_int (st.st_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2846 if (XINT (end) != st.st_size)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2847 out_of_memory ("Maximum buffer size exceeded", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2848 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2849 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2850
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2851 /* If requested, replace the accessible part of the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2852 with the file contents. Avoid replacing text at the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2853 beginning or end of the buffer that matches the file contents;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2854 that preserves markers pointing to the unchanged parts. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2855 /* The replace-mode code is currently implemented by comparing the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2856 file on disk with the contents in the buffer, character by character.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2857 That works only if the characters on disk are exactly what will go into
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2858 the buffer -- i.e. `binary' conversion.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2859
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2860 FSF tries to implement this in all situations, even the non-binary
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2861 conversion, by (in that case) loading the whole converted file into a
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2862 separate memory area, then doing the comparison. I really don't see
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2863 the point of this, and it will fail spectacularly if the file is many
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2864 megabytes in size. To try to get around this, we could certainly read
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2865 from the beginning and decode as necessary before comparing, but doing
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2866 the same at the end gets very difficult because of the possibility of
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2867 modal coding systems -- trying to decode data from any point forward
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2868 without decoding previous data might always give you different results
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2869 from starting at the beginning. We could try further tricks like
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2870 keeping track of which coding systems are non-modal and providing some
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2871 extra method for such coding systems to be given a chunk of data that
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2872 came from a specified location in a specified file and ask the coding
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2873 systems to return a "sync point" from which the data can be read
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2874 forward and have results guaranteed to be the same as reading from the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2875 beginning to that point, but I really don't think it's worth it. If
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2876 we implemented the FSF "brute-force" method, we would have to put a
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2877 reasonable maximum file size on the files. Is any of this worth it?
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2878 --ben
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2879
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2880 */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2881
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2882 if (!NILP (replace))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2883 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2884 if (!do_speedy_insert)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2885 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2886 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2887 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2888 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2889 char buffer[1 << 14];
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2890 Charbpos same_at_start = BUF_BEGV (buf);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2891 Charbpos same_at_end = BUF_ZV (buf);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2892 int overlap;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2893
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2894 /* Count how many chars at the start of the file
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2895 match the text at the beginning of the buffer. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2896 while (1)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2897 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2898 int nread;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2899 Charbpos charbpos;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2900 nread = read_allowing_quit (fd, buffer, sizeof (buffer));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2901 if (nread < 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2902 report_file_error ("Reading", filename);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2903 else if (nread == 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2904 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2905 charbpos = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2906 while (charbpos < nread && same_at_start < BUF_ZV (buf)
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2907 && BUF_FETCH_CHAR (buf, same_at_start) ==
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2908 buffer[charbpos])
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2909 same_at_start++, charbpos++;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2910 /* If we found a discrepancy, stop the scan.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2911 Otherwise loop around and scan the next bufferful. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2912 if (charbpos != nread)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2913 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2914 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2915 /* If the file matches the buffer completely,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2916 there's no need to replace anything. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2917 if (same_at_start - BUF_BEGV (buf) == st.st_size)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2918 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2919 retry_close (fd);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2920 unbind_to (speccount);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2921 /* Truncate the buffer to the size of the file. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2922 buffer_delete_range (buf, same_at_start, same_at_end,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2923 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2924 goto handled;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2925 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2926 /* Count how many chars at the end of the file
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2927 match the text at the end of the buffer. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2928 while (1)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2929 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2930 int total_read, nread;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2931 Charcount charbpos, curpos, trial;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2932
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2933 /* At what file position are we now scanning? */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2934 curpos = st.st_size - (BUF_ZV (buf) - same_at_end);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2935 /* If the entire file matches the buffer tail, stop the scan. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2936 if (curpos == 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2937 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2938 /* How much can we scan in the next step? */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2939 trial = min (curpos, (Charbpos) sizeof (buffer));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2940 if (lseek (fd, curpos - trial, 0) < 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2941 report_file_error ("Setting file position", filename);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2942
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2943 total_read = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2944 while (total_read < trial)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2945 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2946 nread = read_allowing_quit (fd, buffer + total_read,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2947 trial - total_read);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2948 if (nread <= 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2949 report_file_error ("IO error reading file", filename);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2950 total_read += nread;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2951 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2952 /* Scan this bufferful from the end, comparing with
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2953 the Emacs buffer. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2954 charbpos = total_read;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2955 /* Compare with same_at_start to avoid counting some buffer text
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2956 as matching both at the file's beginning and at the end. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2957 while (charbpos > 0 && same_at_end > same_at_start
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2958 && BUF_FETCH_CHAR (buf, same_at_end - 1) ==
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2959 buffer[charbpos - 1])
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2960 same_at_end--, charbpos--;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2961 /* If we found a discrepancy, stop the scan.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2962 Otherwise loop around and scan the preceding bufferful. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2963 if (charbpos != 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2964 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2965 /* If display current starts at beginning of line,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2966 keep it that way. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2967 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2968 XWINDOW (Fselected_window (Qnil))->start_at_line_beg =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2969 !NILP (Fbolp (wrap_buffer (buf)));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2970 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2971
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2972 /* Don't try to reuse the same piece of text twice. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2973 overlap = same_at_start - BUF_BEGV (buf) -
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2974 (same_at_end + st.st_size - BUF_ZV (buf));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2975 if (overlap > 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2976 same_at_end += overlap;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2977
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2978 /* Arrange to read only the nonmatching middle part of the file. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2979 start = make_int (same_at_start - BUF_BEGV (buf));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2980 end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2981
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2982 buffer_delete_range (buf, same_at_start, same_at_end,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2983 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2984 /* Insert from the file at the proper position. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2985 BUF_SET_PT (buf, same_at_start);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2988
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989 if (!not_regular)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2991 total = XINT (end) - XINT (start);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2992
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993 /* Make sure point-max won't overflow after this insertion. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994 if (total != XINT (make_int (total)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2995 out_of_memory ("Maximum buffer size exceeded", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2996 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 /* For a special file, all we can do is guess. The value of -1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2999 will make the stream functions read as much as possible. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3000 total = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3001
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3002 if (XINT (start) != 0
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3003 /* why was this here? asked jwz. The reason is that the replace-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004 connivings above will normally put the file pointer other than
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3005 where it should be. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3006 || (!NILP (replace) && do_speedy_insert))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3007 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3008 if (lseek (fd, XINT (start), 0) < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3009 report_file_error ("Setting file position", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
3013 Charbpos cur_point = BUF_PT (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016 LSTR_ALLOW_QUIT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3018 NGCPRO1 (stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3019 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3020 stream = make_coding_input_stream
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3021 (XLSTREAM (stream), get_coding_system_for_text_file (codesys, 1),
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
3022 CODING_DECODE, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3023 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025 record_unwind_protect (delete_stream_unwind, stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3026
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3027 /* No need to limit the amount of stuff we attempt to read. (It would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 occurs inside of the filedesc stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3031 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
3032 Bytecount this_len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033 Charcount cc_inserted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3035 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3036 this_len = Lstream_read (XLSTREAM (stream), read_buf,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3037 sizeof (read_buf));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3039 if (this_len <= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3040 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3041 if (this_len < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3042 saverrno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3043 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3044 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3045
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3046 cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047 this_len,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048 !NILP (visit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049 ? INSDEL_NO_LOCKING : 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050 inserted += cc_inserted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3051 cur_point += cc_inserted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3052 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053 if (!NILP (used_codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3054 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3055 Fset (used_codesys,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3056 XCODING_SYSTEM_NAME
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3057 (coding_stream_detected_coding_system (XLSTREAM (stream))));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3058 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3059 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3062 /* Close the file/stream */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3063 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065 if (saverrno != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3067 errno = saverrno;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3068 report_file_error ("Reading", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3069 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3070
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3071 notfound:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072 handled:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3073
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3074 end_multiple_change (buf, mc_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3075
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3076 if (!NILP (visit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3077 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3078 if (!EQ (buf->undo_list, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3079 buf->undo_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3081 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 buf->modtime = st.st_mtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 buf->filename = filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3084 /* XEmacs addition: */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085 /* This function used to be in C, ostensibly so that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086 it could be called here. But that's just silly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087 There's no reason C code can't call out to Lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3088 code, and it's a lot cleaner this way. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3089 /* Note: compute-buffer-file-truename is called for
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3090 side-effect! Its return value is intentionally
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3091 ignored. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3092 if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3093 call1 (Qcompute_buffer_file_truename, wrap_buffer (buf));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3094 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3095 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 buf->auto_save_modified = BUF_MODIFF (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097 buf->saved_size = make_int (BUF_SIZE (buf));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3099 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3101 if (!NILP (buf->file_truename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102 unlock_file (buf->file_truename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3103 unlock_file (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3104 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3105 #endif /* CLASH_DETECTION */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3106 if (not_regular)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3107 RETURN_UNGCPRO (Fsignal (Qfile_error,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3108 list2 (build_msg_string ("not a regular file"),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3109 filename)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3111 /* If visiting nonexistent file, return nil. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3112 if (buf->modtime == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3113 report_file_error ("Opening input file",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3114 filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3115 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3117 /* Decode file format */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3118 if (inserted > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3119 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3120 Lisp_Object insval = call3 (Qformat_decode,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3121 Qnil, make_int (inserted), visit);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3122 CHECK_INT (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3123 inserted = XINT (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3124 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3126 if (inserted > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3127 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3128 Lisp_Object p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3129 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3131 NGCPRO1 (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3132 EXTERNAL_LIST_LOOP (p, Vafter_insert_file_functions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3133 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3134 Lisp_Object insval =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3135 call1 (XCAR (p), make_int (inserted));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3136 if (!NILP (insval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3137 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3138 CHECK_NATNUM (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3139 inserted = XINT (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3140 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3141 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3142 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3143 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3144 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3146 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3148 if (!NILP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3149 return (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3150 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3151 return (list2 (filename, make_int (inserted)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3152 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3155 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3156 Lisp_Object *annot);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3157 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3159 /* If build_annotations switched buffers, switch back to BUF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3160 Kill the temporary buffer that was selected in the meantime. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 build_annotations_unwind (Lisp_Object buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165 Lisp_Object tembuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167 if (XBUFFER (buf) == current_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3168 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3169 tembuf = Fcurrent_buffer ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3170 Fset_buffer (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171 Fkill_buffer (tembuf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 "r\nFWrite region to file: ", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 Write current region into specified file; no coding-system frobbing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178 This function is identical to `write-region' except for the handling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179 of the CODESYS argument under XEmacs/Mule. (When Mule support is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180 present, both functions are identical and ignore the CODESYS argument.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3181 If support for Mule exists in this Emacs, the file is encoded according
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3182 to the value of CODESYS. If this is nil, no code conversion occurs.
764
3c5d0bca9200 [xemacs-hg @ 2002-03-05 13:00:37 by stephent]
stephent
parents: 751
diff changeset
3183
3c5d0bca9200 [xemacs-hg @ 2002-03-05 13:00:37 by stephent]
stephent
parents: 751
diff changeset
3184 As a special kludge to support auto-saving, when START is nil START and
3c5d0bca9200 [xemacs-hg @ 2002-03-05 13:00:37 by stephent]
stephent
parents: 751
diff changeset
3185 END are set to the beginning and end, respectively, of the buffer,
3c5d0bca9200 [xemacs-hg @ 2002-03-05 13:00:37 by stephent]
stephent
parents: 751
diff changeset
3186 regardless of any restrictions. Don't use this feature. It is documented
3c5d0bca9200 [xemacs-hg @ 2002-03-05 13:00:37 by stephent]
stephent
parents: 751
diff changeset
3187 here because write-region handler writers need to be aware of it.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 (start, end, filename, append, visit, lockname, codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3190 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3191 /* This function can call lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192 int desc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3193 int failure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194 int save_errno = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195 struct stat st;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3196 Lisp_Object fn = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198 int visiting_other = STRINGP (visit);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199 int visiting = (EQ (visit, Qt) || visiting_other);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200 int quietly = (!visiting && !NILP (visit));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3201 Lisp_Object visit_file = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3202 Lisp_Object annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3203 struct buffer *given_buffer;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
3204 Charbpos start1, end1;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3205 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3206 struct gcpro ngcpro1, ngcpro2;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3207 Lisp_Object curbuf = wrap_buffer (current_buffer);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3208
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3209
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3210 /* start, end, visit, and append are never modified in this fun
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3211 so we don't protect them. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3212 GCPRO5 (visit_file, filename, codesys, lockname, annotations);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3213 NGCPRO2 (curbuf, fn);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3214
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3215 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 we should signal an error rather than blissfully continuing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 along. ARGH, this function is going to lose lose lose. We need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 to protect the current_buffer from being destroyed, but the
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3219 multiple return points make this a pain in the butt. ]] we do
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3220 protect curbuf now. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3221
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3222 codesys = get_coding_system_for_text_file (codesys, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3224 if (current_buffer->base_buffer && ! NILP (visit))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3225 invalid_operation ("Cannot do file visiting in an indirect buffer",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3226 curbuf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228 if (!NILP (start) && !STRINGP (start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 if (visiting_other)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3235 visit_file = Fexpand_file_name (visit, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237 visit_file = filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 if (NILP (lockname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241 lockname = visit_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3242
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3243 /* We used to UNGCPRO here. BAD! visit_file is used below after
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3244 more Lisp calling. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247 handler = Ffind_file_name_handler (filename, Qwrite_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 /* If FILENAME has no handler, see if VISIT has one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 if (NILP (handler) && STRINGP (visit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250 handler = Ffind_file_name_handler (visit, Qwrite_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3254 Lisp_Object val = call8 (handler, Qwrite_region, start, end,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3255 filename, append, visit, lockname, codesys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3256 if (visiting)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3257 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3258 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3259 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 current_buffer->filename = visit_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3261 MARK_MODELINE_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3262 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3263 NUNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3264 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3265 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3266 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3267 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3268
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3269 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3270 if (!auto_saving)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3271 lock_file (lockname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3272 #endif /* CLASH_DETECTION */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3274 /* Special kludge to simplify auto-saving. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275 if (NILP (start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3276 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3277 start1 = BUF_BEG (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3278 end1 = BUF_Z (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3279 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3281 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3283 given_buffer = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3284 annotations = build_annotations (start, end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3285 if (current_buffer != given_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3286 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3287 start1 = BUF_BEGV (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3288 end1 = BUF_ZV (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3289 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3290
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3291 fn = filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3292 desc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3293 if (!NILP (append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3294 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3295 desc = qxe_open (XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3296 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3297 if (desc < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3298 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3299 desc = qxe_open (XSTRING_DATA (fn),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3300 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3301 auto_saving ? auto_save_mode_bits : CREAT_MODE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3302 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3304 if (desc < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3305 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3306 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3307 save_errno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3308 if (!auto_saving) unlock_file (lockname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3309 errno = save_errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3310 #endif /* CLASH_DETECTION */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3311 report_file_error ("Opening output file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3312 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3314 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3315 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3316 Lisp_Object instream = Qnil, outstream = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3317 struct gcpro nngcpro1, nngcpro2;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3318 /* need to gcpro; QUIT could happen out of call to retry_write() */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3319 NNGCPRO2 (instream, outstream);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3321 record_unwind_protect (close_file_unwind, desc_locative);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3323 if (!NILP (append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3324 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3325 if (lseek (desc, 0, 2) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3326 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3327 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3328 if (!auto_saving) unlock_file (lockname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3329 #endif /* CLASH_DETECTION */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3330 report_file_error ("Lseek error",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3331 filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3332 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3333 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3334
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3335 failure = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3337 /* Note: I tried increasing the buffering size, along with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3338 various other tricks, but nothing seemed to make much of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3339 a difference in the time it took to save a large file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3340 (Actually that's not true. With a local disk, changing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3341 the buffer size doesn't seem to make much difference.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3342 With an NFS-mounted disk, it could make a lot of difference
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3343 because you're affecting the number of network requests
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3344 that need to be made, and there could be a large latency
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3345 for each request. So I've increased the buffer size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3346 to 64K.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3347 outstream = make_filedesc_output_stream (desc, 0, -1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3348 Lstream_set_buffering (XLSTREAM (outstream),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3349 LSTREAM_BLOCKN_BUFFERED, 65536);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3350 outstream =
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
3351 make_coding_output_stream (XLSTREAM (outstream), codesys,
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
3352 CODING_ENCODE, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3353 Lstream_set_buffering (XLSTREAM (outstream),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3354 LSTREAM_BLOCKN_BUFFERED, 65536);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3355 if (STRINGP (start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3356 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3357 instream = make_lisp_string_input_stream (start, 0, -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3358 start1 = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3359 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3360 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3361 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3362 LSTR_SELECTIVE |
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3363 LSTR_IGNORE_ACCESSIBLE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3364 failure = (0 > (a_write (outstream, instream, start1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3365 &annotations)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3366 save_errno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3367 /* Note that this doesn't close the desc since we created the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3368 stream without the LSTR_CLOSING flag, but it does
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3369 flush out any buffered data. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3370 if (Lstream_close (XLSTREAM (outstream)) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3371 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3372 failure = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3373 save_errno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3374 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3375 Lstream_close (XLSTREAM (instream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3377 #ifdef HAVE_FSYNC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3378 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3379 Disk full in NFS may be reported here. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3380 /* mib says that closing the file will try to write as fast as NFS can do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3381 it, and that means the fsync here is not crucial for autosave files. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3382 if (!auto_saving && fsync (desc) < 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3383 /* If fsync fails with EINTR, don't treat that as serious. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3384 && errno != EINTR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3385 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3386 failure = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3387 save_errno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3388 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3389 #endif /* HAVE_FSYNC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3390
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
3391 /* Spurious "file has changed on disk" warnings used to be seen on
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
3392 systems where close() can change the modtime. This is known to
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
3393 happen on various NFS file systems, on Windows, and on Linux.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
3394 Rather than handling this on a per-system basis, we
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3395 unconditionally do the qxe_stat() after the retry_close(). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3397 /* NFS can report a write failure now. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3398 if (retry_close (desc) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3399 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3400 failure = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3401 save_errno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3402 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3403
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3404 /* Discard the close unwind-protect. Execute the one for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3405 build_annotations (switches back to the original current buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3406 as necessary). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3407 XCAR (desc_locative) = Qnil;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3408 unbind_to (speccount);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3409
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3410 NNUNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3411 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3412
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3413 qxe_stat (XSTRING_DATA (fn), &st);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3414
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3415 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3416 if (!auto_saving)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3417 unlock_file (lockname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3418 #endif /* CLASH_DETECTION */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3420 /* Do this before reporting IO error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3421 to avoid a "file has changed on disk" warning on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3422 next attempt to save. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3423 if (visiting)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3424 current_buffer->modtime = st.st_mtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3425
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3426 if (failure)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3427 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3428 errno = save_errno;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3429 report_file_error ("Writing file", fn);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3430 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3431
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3432 if (visiting)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3433 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3434 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3435 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3436 current_buffer->filename = visit_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3437 MARK_MODELINE_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3438 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3439 else if (quietly)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3440 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3441 NUNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3442 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3443 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3444 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3446 if (!auto_saving)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3447 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3448 if (visiting_other)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3449 message ("Wrote %s", XSTRING_DATA (visit_file));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3450 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3451 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3452 Lisp_Object fsp = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3453 struct gcpro nngcpro1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3454
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3455 NNGCPRO1 (fsp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3456 fsp = Ffile_symlink_p (fn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3457 if (NILP (fsp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3458 message ("Wrote %s", XSTRING_DATA (fn));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3459 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3460 message ("Wrote %s (symlink to %s)",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3461 XSTRING_DATA (fn), XSTRING_DATA (fsp));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3462 NNUNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3463 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3464 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3465 NUNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3466 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3467 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3468 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3469
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3470 /* #### This is such a load of shit!!!! There is no way we should define
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3471 something so stupid as a subr, just sort the fucking list more
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3472 intelligently. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3473 DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3474 Return t if (car A) is numerically less than (car B).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3475 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3476 (a, b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3477 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3478 Lisp_Object objs[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3479 objs[0] = Fcar (a);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3480 objs[1] = Fcar (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3481 return Flss (2, objs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3482 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3484 /* Heh heh heh, let's define this too, just to aggravate the person who
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3485 wrote the above comment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3486 DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3487 Return t if (cdr A) is numerically less than (cdr B).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3488 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3489 (a, b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3490 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3491 Lisp_Object objs[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3492 objs[0] = Fcdr (a);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3493 objs[1] = Fcdr (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3494 return Flss (2, objs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3495 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3496
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3497 /* Build the complete list of annotations appropriate for writing out
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3498 the text between START and END, by calling all the functions in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3499 write-region-annotate-functions and merging the lists they return.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3500 If one of these functions switches to a different buffer, we assume
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3501 that buffer contains altered text. Therefore, the caller must
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3502 make sure to restore the current buffer in all cases,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3503 as save-excursion would do. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3504
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3505 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3506 build_annotations (Lisp_Object start, Lisp_Object end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3507 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3508 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3509 Lisp_Object annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3510 Lisp_Object p, res;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3511 struct gcpro gcpro1, gcpro2;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3512 Lisp_Object original_buffer = wrap_buffer (current_buffer);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3513
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3514
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3515 annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3516 p = Vwrite_region_annotate_functions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3517 GCPRO2 (annotations, p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3518 while (!NILP (p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3519 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3520 struct buffer *given_buffer = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3521 Vwrite_region_annotations_so_far = annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3522 res = call2 (Fcar (p), start, end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3523 /* If the function makes a different buffer current,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3524 assume that means this buffer contains altered text to be output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3525 Reset START and END from the buffer bounds
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3526 and discard all previous annotations because they should have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3527 been dealt with by this function. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3528 if (current_buffer != given_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3529 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3530 start = make_int (BUF_BEGV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3531 end = make_int (BUF_ZV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3532 annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3533 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3534 Flength (res); /* Check basic validity of return value */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3535 annotations = merge (annotations, res, Qcar_less_than_car);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3536 p = Fcdr (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3537 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3538
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3539 /* Now do the same for annotation functions implied by the file-format */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3540 if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3541 p = Vauto_save_file_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3542 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3543 p = current_buffer->file_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3544 while (!NILP (p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3545 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3546 struct buffer *given_buffer = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3547 Vwrite_region_annotations_so_far = annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3548 res = call4 (Qformat_annotate_function, Fcar (p), start, end,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3549 original_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3550 if (current_buffer != given_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3551 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3552 start = make_int (BUF_BEGV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3553 end = make_int (BUF_ZV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3554 annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3555 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3556 Flength (res);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3557 annotations = merge (annotations, res, Qcar_less_than_car);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3558 p = Fcdr (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3559 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3560 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3561 return annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3562 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3563
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3564 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3565 EOF is encountered), assuming they start at position POS in the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3566 of string that STREAM refers to. Intersperse with them the annotations
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3567 from *ANNOT that fall into the range of positions we are reading from,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3568 each at its appropriate position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3569
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3570 Modify *ANNOT by discarding elements as we output them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3571 The return value is negative in case of system call failure. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3573 /* 4K should probably be fine. We just need to reduce the number of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3574 function calls to reasonable level. The Lstream stuff itself will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3575 batch to 64K to reduce the number of system calls. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3577 #define A_WRITE_BATCH_SIZE 4096
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3579 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3580 a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3581 Lisp_Object *annot)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3582 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3583 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3584 int nextpos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3585 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3586 Lstream *instr = XLSTREAM (instream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3587 Lstream *outstr = XLSTREAM (outstream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3588
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3589 while (LISTP (*annot))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3590 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3591 tem = Fcar_safe (Fcar (*annot));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3592 if (INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3593 nextpos = XINT (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3594 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3595 nextpos = INT_MAX;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3596 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3597 /* If there are annotations left and we have Mule, then we
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3598 have to do the I/O one ichar at a time so we can
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3599 determine when to insert the annotation. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3600 if (!NILP (*annot))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3601 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3602 Ichar ch;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3603 while (pos != nextpos && (ch = Lstream_get_ichar (instr)) != EOF)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3604 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3605 if (Lstream_put_ichar (outstr, ch) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3606 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3607 pos++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3608 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3609 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3610 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3611 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3612 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3613 while (pos != nextpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3614 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3615 /* Otherwise there is no point to that. Just go in batches. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3616 int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3617
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3618 chunk = Lstream_read (instr, largebuf, chunk);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3619 if (chunk < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3620 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3621 if (chunk == 0) /* EOF */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3622 break;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3623 if (Lstream_write (outstr, largebuf, chunk) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3624 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3625 pos += chunk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3626 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3627 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3628 if (pos == nextpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3629 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3630 tem = Fcdr (Fcar (*annot));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3631 if (STRINGP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3632 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3633 if (Lstream_write (outstr, XSTRING_DATA (tem),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3634 XSTRING_LENGTH (tem)) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3635 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3636 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3637 *annot = Fcdr (*annot);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3638 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3639 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3640 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3641 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3642 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3643 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3645
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3646
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3647 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3648 #include <des_crypt.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3650 #define CRYPT_BLOCK_SIZE 8 /* bytes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3651 #define CRYPT_KEY_SIZE 8 /* bytes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3652
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3653 DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3654 Encrypt STRING using KEY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3655 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3656 (string, key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3657 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3658 char *encrypted_string, *raw_key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3659 int rounded_size, extra, key_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3660
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3661 /* !!#### May produce bogus data under Mule. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3662 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3663 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3665 extra = XSTRING_LENGTH (string) % CRYPT_BLOCK_SIZE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3666 rounded_size = XSTRING_LENGTH (string) + extra;
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 844
diff changeset
3667 encrypted_string = ALLOCA (rounded_size + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3668 memcpy (encrypted_string, XSTRING_DATA (string), XSTRING_LENGTH (string));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3669 memset (encrypted_string + rounded_size - extra, 0, extra + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3670
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3671 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3672
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 844
diff changeset
3673 raw_key = ALLOCA (CRYPT_KEY_SIZE + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3674 memcpy (raw_key, XSTRING_DATA (key), key_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3675 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3676
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3677 ecb_crypt (raw_key, encrypted_string, rounded_size,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3678 DES_ENCRYPT | DES_SW);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3679 return make_string (encrypted_string, rounded_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3680 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3682 DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3683 Decrypt STRING using KEY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3684 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3685 (string, key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3686 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3687 /* !!#### May produce bogus data under Mule. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3688 char *decrypted_string, *raw_key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3689 int string_size, key_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3690
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3691 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3692 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3693
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3694 string_size = XSTRING_LENGTH (string) + 1;
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 844
diff changeset
3695 decrypted_string = ALLOCA (string_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3696 memcpy (decrypted_string, XSTRING_DATA (string), string_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3697 decrypted_string[string_size - 1] = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3698
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3699 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3700
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 844
diff changeset
3701 raw_key = ALLOCA (CRYPT_KEY_SIZE + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3702 memcpy (raw_key, XSTRING_DATA (key), key_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3703 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3704
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3706 ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3707 return make_string (decrypted_string, string_size - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3708 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3709 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3710
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3711
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3712 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3713 Return t if last mod time of BUFFER's visited file matches what BUFFER records.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3714 This means that the file has not been changed since it was visited or saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3715 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3716 (buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3717 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3718 /* This function can call lisp; GC checked 2000-07-11 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3719 struct buffer *b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3720 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3721 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3722
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3723 CHECK_BUFFER (buffer);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3724 b = XBUFFER (buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3725
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3726 if (!STRINGP (b->filename)) return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3727 if (b->modtime == 0) return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3728
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3729 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3730 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3731 handler = Ffind_file_name_handler (b->filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3732 Qverify_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3733 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3734 return call2 (handler, Qverify_visited_file_modtime, buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3735
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3736 if (qxe_stat (XSTRING_DATA (b->filename), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3737 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3738 /* If the file doesn't exist now and didn't exist before,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3739 we say that it isn't modified, provided the error is a tame one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3740 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3741 st.st_mtime = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3742 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3743 st.st_mtime = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3744 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3745 if (st.st_mtime == b->modtime
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3746 /* If both are positive, accept them if they are off by one second. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3747 || (st.st_mtime > 0 && b->modtime > 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3748 && (st.st_mtime == b->modtime + 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3749 || st.st_mtime == b->modtime - 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3750 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3751 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3752 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3753
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3754 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3755 Clear out records of last mod time of visited file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3756 Next attempt to save will certainly not complain of a discrepancy.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3757 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3758 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3759 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3760 current_buffer->modtime = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3761 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3762 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3763
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3764 DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3765 Return the current buffer's recorded visited file modification time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3766 The value is a list of the form (HIGH . LOW), like the time values
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3767 that `file-attributes' returns.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3768 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3769 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3770 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3771 return time_to_lisp ((time_t) current_buffer->modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3772 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3773
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3774 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3775 Update buffer's recorded modification time from the visited file's time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3776 Useful if the buffer was not read from the file normally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3777 or if the file itself has been changed for some known benign reason.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3778 An argument specifies the modification time value to use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3779 \(instead of that of the visited file), in the form of a list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3780 \(HIGH . LOW) or (HIGH LOW).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3781 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3782 (time_list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3783 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3784 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3785 if (!NILP (time_list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3786 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3787 time_t the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3788 lisp_to_time (time_list, &the_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3789 current_buffer->modtime = (int) the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3790 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3791 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3792 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3793 Lisp_Object filename = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3794 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3795 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3796 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3797
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3798 GCPRO3 (filename, time_list, current_buffer->filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3799 filename = Fexpand_file_name (current_buffer->filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3800
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3801 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3802 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3803 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3804 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3805 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3806 /* The handler can find the file name the same way we did. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3807 return call2 (handler, Qset_visited_file_modtime, Qnil);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3808 else if (qxe_stat (XSTRING_DATA (filename), &st) >= 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3809 current_buffer->modtime = st.st_mtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3810 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3811
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3812 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3813 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3814
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3815 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3816 auto_save_error (Lisp_Object condition_object, Lisp_Object ignored)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3817 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3818 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3819 if (gc_in_progress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3820 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3821 /* Don't try printing an error message after everything is gone! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3822 if (preparing_for_armageddon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3823 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3824 clear_echo_area (selected_frame (), Qauto_saving, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3825 Fding (Qt, Qauto_save_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3826 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3827 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3828 message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3829 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3830 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3831 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3832 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3833 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3834
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3835 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3836 auto_save_1 (Lisp_Object ignored)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3837 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3838 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3839 /* #### I think caller is protecting current_buffer? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3840 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3841 Lisp_Object fn = current_buffer->filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3842 Lisp_Object a = current_buffer->auto_save_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3843
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3844 if (!STRINGP (a))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3845 return (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3846
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3847 /* Get visited file's mode to become the auto save file's mode. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3848 if (STRINGP (fn) &&
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3849 qxe_stat (XSTRING_DATA (fn), &st) >= 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3850 /* But make sure we can overwrite it later! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3851 auto_save_mode_bits = st.st_mode | 0600;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3852 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3853 /* default mode for auto-save files of buffers with no file is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3854 readable by owner only. This may annoy some small number of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3855 people, but the alternative removes all privacy from email. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3856 auto_save_mode_bits = 0600;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3857
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3858 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3859 Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3860 #if 1 /* #### Kyle wants it changed to not use escape-quoted. Think
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3861 carefully about how this works. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3862 Qescape_quoted
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3863 #else
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
3864 current_buffer->buffer_file_coding_system
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3865 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3866 );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3867 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3868
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3869 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3870 auto_save_expand_name_error (Lisp_Object condition_object, Lisp_Object ignored)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3871 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3872 warn_when_safe_lispobj
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3873 (Qfile, Qerror,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3874 Fcons (build_msg_string ("Invalid auto-save list-file"),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3875 Fcons (Vauto_save_list_file_name,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3876 condition_object)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3877 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3878 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3879
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3880 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3881 auto_save_expand_name (Lisp_Object name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3882 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3883 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3884
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3885 /* note that caller did NOT gc protect name, so we do it. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3886 /* [[dmoore - this might not be necessary, if condition_case_1
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3887 protects it. but I don't think it does.]] indeed it doesn't. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3888 GCPRO1 (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3889 RETURN_UNGCPRO (Fexpand_file_name (name, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3890 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3891
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3892
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3893 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3894 do_auto_save_unwind (Lisp_Object fd)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3895 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3896 retry_close (XINT (fd));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3897 return (fd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3898 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3899
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3900 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3901 and if so, tries to avoid touching lisp objects.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3902
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3903 The only time that Fdo_auto_save() is called while GC is in progress
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3904 is if we're going down, as a result of an abort() or a kill signal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3905 It's fairly important that we generate autosave files in that case!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3906 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3907
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3908 DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3909 Auto-save all buffers that need it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3910 This is all buffers that have auto-saving enabled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3911 and are changed since last auto-saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3912 Auto-saving writes the buffer into a file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3913 so that your editing is not lost if the system crashes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3914 This file is not the file you visited; that changes only when you save.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3915 Normally we run the normal hook `auto-save-hook' before saving.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3916
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3917 Non-nil first argument means do not print any message if successful.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3918 Non-nil second argument means save only current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3919 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3920 (no_message, current_only))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3921 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3922 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3923 struct buffer *b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3924 Lisp_Object tail, buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3925 int auto_saved = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3926 int do_handled_files;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3927 Lisp_Object oquit = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3928 Lisp_Object listfile = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3929 Lisp_Object old;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3930 int listdesc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3931 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3932 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3933
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3934 old = wrap_buffer (current_buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3935 GCPRO3 (oquit, listfile, old);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3936 check_quit (); /* make Vquit_flag accurate */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3937 /* Ordinarily don't quit within this function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3938 but don't make it impossible to quit (in case we get hung in I/O). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3939 oquit = Vquit_flag;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3940 Vquit_flag = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3941
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3942 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3943 variables point to non-strings reached from Vbuffer_alist. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3944
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3945 if (minibuf_level != 0 || preparing_for_armageddon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3946 no_message = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3947
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3948 run_hook (Qauto_save_hook);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3949
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3950 if (STRINGP (Vauto_save_list_file_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3951 listfile = condition_case_1 (Qt,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3952 auto_save_expand_name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3953 Vauto_save_list_file_name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3954 auto_save_expand_name_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3955
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3956 internal_bind_int (&auto_saving, 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3957
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3958 /* First, save all files which don't have handlers. If Emacs is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3959 crashing, the handlers may tweak what is causing Emacs to crash
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3960 in the first place, and it would be a shame if Emacs failed to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3961 autosave perfectly ordinary files because it couldn't handle some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3962 ange-ftp'd file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3963 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3964 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3965 for (tail = Vbuffer_alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3966 CONSP (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3967 tail = XCDR (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3968 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3969 buf = XCDR (XCAR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3970 b = XBUFFER (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3971
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3972 if (!NILP (current_only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3973 && b != current_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3974 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3975
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3976 /* Don't auto-save indirect buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3977 The base buffer takes care of it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3978 if (b->base_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3979 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3981 /* Check for auto save enabled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3982 and file changed since last auto save
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3983 and file changed since last real save. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3984 if (STRINGP (b->auto_save_file_name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3985 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3986 && b->auto_save_modified < BUF_MODIFF (b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3987 /* -1 means we've turned off autosaving for a while--see below. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3988 && XINT (b->saved_size) >= 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3989 && (do_handled_files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3990 || NILP (Ffind_file_name_handler (b->auto_save_file_name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3991 Qwrite_region))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3992 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3993 EMACS_TIME before_time, after_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3994
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3995 EMACS_GET_TIME (before_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3996 /* If we had a failure, don't try again for 20 minutes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3997 if (!preparing_for_armageddon
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3998 && b->auto_save_failure_time >= 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3999 && (EMACS_SECS (before_time) - b->auto_save_failure_time <
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4000 1200))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4001 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4003 if (!preparing_for_armageddon &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4004 (XINT (b->saved_size) * 10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4005 > (BUF_Z (b) - BUF_BEG (b)) * 13)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4006 /* A short file is likely to change a large fraction;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4007 spare the user annoying messages. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4008 && XINT (b->saved_size) > 5000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4009 /* These messages are frequent and annoying for `*mail*'. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4010 && !NILP (b->filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4011 && NILP (no_message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4012 && disable_auto_save_when_buffer_shrinks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4013 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4014 /* It has shrunk too much; turn off auto-saving here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4015 Unless we're about to crash, in which case auto-save it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4016 anyway.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4017 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4018 message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4019 ("Buffer %s has shrunk a lot; auto save turned off there",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4020 XSTRING_DATA (b->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4021 /* Turn off auto-saving until there's a real save,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4022 and prevent any more warnings. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4023 b->saved_size = make_int (-1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4024 if (!gc_in_progress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4025 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4026 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4027 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4028 set_buffer_internal (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4029 if (!auto_saved && NILP (no_message))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4030 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4031 static const unsigned char *msg
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4032 = (const unsigned char *) "Auto-saving...";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4033 echo_area_message (selected_frame (), msg, Qnil,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4034 0, strlen ((const char *) msg),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4035 Qauto_saving);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4036 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4037
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4038 /* Open the auto-save list file, if necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4039 We only do this now so that the file only exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4040 if we actually auto-saved any files. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4041 if (!auto_saved && !inhibit_auto_save_session
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4042 && !NILP (Vauto_save_list_file_prefix)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4043 && STRINGP (listfile) && listdesc < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4044 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4045 listdesc =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4046 qxe_open (XSTRING_DATA (listfile),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4047 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4048 CREAT_MODE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4050 /* Arrange to close that file whether or not we get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4051 an error. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4052 if (listdesc >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4053 record_unwind_protect (do_auto_save_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4054 make_int (listdesc));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4055 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4056
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4057 /* Record all the buffers that we are auto-saving in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4058 the special file that lists them. For each of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4059 these buffers, record visited name (if any) and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4060 auto save name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4061 if (listdesc >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4062 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4063 const Extbyte *auto_save_file_name_ext;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
4064 Bytecount auto_save_file_name_ext_len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4065
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4066 TO_EXTERNAL_FORMAT (LISP_STRING, b->auto_save_file_name,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4067 ALLOCA, (auto_save_file_name_ext,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4068 auto_save_file_name_ext_len),
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4069 Qescape_quoted);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4070 if (!NILP (b->filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4071 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4072 const Extbyte *filename_ext;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
4073 Bytecount filename_ext_len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4074
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4075 TO_EXTERNAL_FORMAT (LISP_STRING, b->filename,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4076 ALLOCA, (filename_ext,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4077 filename_ext_len),
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4078 Qescape_quoted);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4079 retry_write (listdesc, filename_ext, filename_ext_len);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4080 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4081 retry_write (listdesc, "\n", 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4082 retry_write (listdesc, auto_save_file_name_ext,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4083 auto_save_file_name_ext_len);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4084 retry_write (listdesc, "\n", 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4085 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4086
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4087 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4088 based on values in Vbuffer_alist. auto_save_1 may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4089 cause lisp handlers to run. Those handlers may kill
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4090 the buffer and then GC. Since the buffer is killed,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4091 it's no longer in Vbuffer_alist so it might get reaped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4092 by the GC. We also need to protect tail. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4093 /* #### There is probably a lot of other code which has
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4094 pointers into buffers which may get blown away by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4095 handlers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4096 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4097 struct gcpro ngcpro1, ngcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4098 NGCPRO2 (buf, tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4099 condition_case_1 (Qt,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4100 auto_save_1, Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4101 auto_save_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4102 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4103 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4104 /* Handler killed our saved current-buffer! Pick any. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4105 if (!BUFFER_LIVE_P (XBUFFER (old)))
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
4106 old = wrap_buffer (current_buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4108 set_buffer_internal (XBUFFER (old));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4109 auto_saved++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4111 /* Handler killed their own buffer! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4112 if (!BUFFER_LIVE_P(b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4113 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4115 b->auto_save_modified = BUF_MODIFF (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4116 b->saved_size = make_int (BUF_SIZE (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4117 EMACS_GET_TIME (after_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4118 /* If auto-save took more than 60 seconds,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4119 assume it was an NFS failure that got a timeout. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4120 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4121 b->auto_save_failure_time = EMACS_SECS (after_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4122 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4123 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4124 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4126 /* Prevent another auto save till enough input events come in. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4127 if (auto_saved)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4128 record_auto_save ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4130 /* If we didn't save anything into the listfile, remove the old
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4131 one because nothing needed to be auto-saved. Do this afterwards
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4132 rather than before in case we get a crash attempting to autosave
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4133 (in that case we'd still want the old one around). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4134 if (listdesc < 0 && !auto_saved && STRINGP (listfile))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4135 qxe_unlink (XSTRING_DATA (listfile));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4137 /* Show "...done" only if the echo area would otherwise be empty. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4138 if (auto_saved && NILP (no_message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4139 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4140 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4141 static const unsigned char *msg
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4142 = (const unsigned char *)"Auto-saving...done";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4143 echo_area_message (selected_frame (), msg, Qnil, 0,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4144 strlen ((const char *) msg), Qauto_saving);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4145 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4147 Vquit_flag = oquit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4148
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4149 RETURN_UNGCPRO (unbind_to (speccount));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4150 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4152 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4153 Mark current buffer as auto-saved with its current text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4154 No auto-save file will be written until the buffer changes again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4155 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4156 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4157 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4158 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4159 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4160 current_buffer->auto_save_failure_time = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4161 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4162 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4164 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4165 Clear any record of a recent auto-save failure in the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4166 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4167 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4168 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4169 current_buffer->auto_save_failure_time = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4170 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4171 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4173 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4174 Return t if buffer has been auto-saved since last read in or saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4175 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4176 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4177 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4178 return (BUF_SAVE_MODIFF (current_buffer) <
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4179 current_buffer->auto_save_modified) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4180 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4181
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4182
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4183 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4184 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4185 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4187 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4188 syms_of_fileio (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4189 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4190 DEFSYMBOL (Qexpand_file_name);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4191 DEFSYMBOL (Qfile_truename);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4192 DEFSYMBOL (Qsubstitute_in_file_name);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4193 DEFSYMBOL (Qdirectory_file_name);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4194 DEFSYMBOL (Qfile_name_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4195 DEFSYMBOL (Qfile_name_nondirectory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4196 DEFSYMBOL (Qunhandled_file_name_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4197 DEFSYMBOL (Qfile_name_as_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4198 DEFSYMBOL (Qcopy_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4199 DEFSYMBOL (Qmake_directory_internal);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4200 DEFSYMBOL (Qdelete_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4201 DEFSYMBOL (Qdelete_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4202 DEFSYMBOL (Qrename_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4203 DEFSYMBOL (Qadd_name_to_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4204 DEFSYMBOL (Qmake_symbolic_link);
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
4205 DEFSYMBOL (Qmake_temp_name);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4206 DEFSYMBOL (Qfile_exists_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4207 DEFSYMBOL (Qfile_executable_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4208 DEFSYMBOL (Qfile_readable_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4209 DEFSYMBOL (Qfile_symlink_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4210 DEFSYMBOL (Qfile_writable_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4211 DEFSYMBOL (Qfile_directory_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4212 DEFSYMBOL (Qfile_regular_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4213 DEFSYMBOL (Qfile_accessible_directory_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4214 DEFSYMBOL (Qfile_modes);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4215 DEFSYMBOL (Qset_file_modes);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4216 DEFSYMBOL (Qfile_newer_than_file_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4217 DEFSYMBOL (Qinsert_file_contents);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4218 DEFSYMBOL (Qwrite_region);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4219 DEFSYMBOL (Qverify_visited_file_modtime);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4220 DEFSYMBOL (Qset_visited_file_modtime);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4221 DEFSYMBOL (Qcar_less_than_car); /* Vomitous! */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4222
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4223 DEFSYMBOL (Qauto_save_hook);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4224 DEFSYMBOL (Qauto_save_error);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4225 DEFSYMBOL (Qauto_saving);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4226
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4227 DEFSYMBOL (Qformat_decode);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4228 DEFSYMBOL (Qformat_annotate_function);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4229
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4230 DEFSYMBOL (Qcompute_buffer_file_truename);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4231
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4232 DEFERROR_STANDARD (Qfile_already_exists, Qfile_error);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4234 DEFSUBR (Ffind_file_name_handler);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4235
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4236 DEFSUBR (Ffile_name_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4237 DEFSUBR (Ffile_name_nondirectory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4238 DEFSUBR (Funhandled_file_name_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4239 DEFSUBR (Ffile_name_as_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4240 DEFSUBR (Fdirectory_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4241 DEFSUBR (Fmake_temp_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4242 DEFSUBR (Fexpand_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4243 DEFSUBR (Ffile_truename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4244 DEFSUBR (Fsubstitute_in_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4245 DEFSUBR (Fcopy_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4246 DEFSUBR (Fmake_directory_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4247 DEFSUBR (Fdelete_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4248 DEFSUBR (Fdelete_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4249 DEFSUBR (Frename_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4250 DEFSUBR (Fadd_name_to_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4251 DEFSUBR (Fmake_symbolic_link);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4252 #ifdef HPUX_NET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4253 DEFSUBR (Fsysnetunam);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4254 #endif /* HPUX_NET */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4255 DEFSUBR (Ffile_name_absolute_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4256 DEFSUBR (Ffile_exists_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4257 DEFSUBR (Ffile_executable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4258 DEFSUBR (Ffile_readable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4259 DEFSUBR (Ffile_writable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4260 DEFSUBR (Ffile_symlink_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4261 DEFSUBR (Ffile_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4262 DEFSUBR (Ffile_accessible_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4263 DEFSUBR (Ffile_regular_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4264 DEFSUBR (Ffile_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4265 DEFSUBR (Fset_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4266 DEFSUBR (Fset_default_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4267 DEFSUBR (Fdefault_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4268 DEFSUBR (Funix_sync);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4269 DEFSUBR (Ffile_newer_than_file_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4270 DEFSUBR (Finsert_file_contents_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4271 DEFSUBR (Fwrite_region_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4272 DEFSUBR (Fcar_less_than_car); /* Vomitous! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4273 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4274 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4275 DEFSUBR (Fencrypt_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4276 DEFSUBR (Fdecrypt_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4277 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4278 DEFSUBR (Fverify_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4279 DEFSUBR (Fclear_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4280 DEFSUBR (Fvisited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4281 DEFSUBR (Fset_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4283 DEFSUBR (Fdo_auto_save);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4284 DEFSUBR (Fset_buffer_auto_saved);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4285 DEFSUBR (Fclear_buffer_auto_save_failure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4286 DEFSUBR (Frecent_auto_save_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4287 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4289 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4290 vars_of_fileio (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4291 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4292 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4293 *Format in which to write auto-save files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4294 Should be a list of symbols naming formats that are defined in `format-alist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4295 If it is t, which is the default, auto-save files are written in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4296 same format as a regular save would use.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4297 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4298 Vauto_save_file_format = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4300 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4301 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4302 If a file name matches REGEXP, then all I/O on that file is done by calling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4303 HANDLER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4305 The first argument given to HANDLER is the name of the I/O primitive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4306 to be handled; the remaining arguments are the arguments that were
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4307 passed to that primitive. For example, if you do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4308 (file-exists-p FILENAME)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4309 and FILENAME is handled by HANDLER, then HANDLER is called like this:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4310 (funcall HANDLER 'file-exists-p FILENAME)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4311 The function `find-file-name-handler' checks this list for a handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4312 for its argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4313 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4314 Vfile_name_handler_alist = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4316 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4317 A list of functions to be called at the end of `insert-file-contents'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4318 Each is passed one argument, the number of bytes inserted. It should return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4319 the new byte count, and leave point the same. If `insert-file-contents' is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4320 intercepted by a handler from `file-name-handler-alist', that handler is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4321 responsible for calling the after-insert-file-functions if appropriate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4322 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4323 Vafter_insert_file_functions = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4325 DEFVAR_LISP ("write-region-annotate-functions",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4326 &Vwrite_region_annotate_functions /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4327 A list of functions to be called at the start of `write-region'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4328 Each is passed two arguments, START and END, as for `write-region'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4329 It should return a list of pairs (POSITION . STRING) of strings to be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4330 effectively inserted at the specified positions of the file being written
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4331 \(1 means to insert before the first byte written). The POSITIONs must be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4332 sorted into increasing order. If there are several functions in the list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4333 the several lists are merged destructively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4334 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4335 Vwrite_region_annotate_functions = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4337 DEFVAR_LISP ("write-region-annotations-so-far",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4338 &Vwrite_region_annotations_so_far /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4339 When an annotation function is called, this holds the previous annotations.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4340 These are the annotations made by other annotation functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4341 that were already called. See also `write-region-annotate-functions'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4342 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4343 Vwrite_region_annotations_so_far = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4344
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4345 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4346 A list of file name handlers that temporarily should not be used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4347 This applies only to the operation `inhibit-file-name-operation'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4348 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4349 Vinhibit_file_name_handlers = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4350
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4351 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4352 The operation for which `inhibit-file-name-handlers' is applicable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4353 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4354 Vinhibit_file_name_operation = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4355
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4356 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4357 File name in which we write a list of all auto save file names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4358 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4359 Vauto_save_list_file_name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4360
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4361 DEFVAR_LISP ("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /*
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4362 Prefix for generating auto-save-list-file-name.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4363 Emacs's pid and the system name will be appended to
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4364 this prefix to create a unique file name.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4365 */ );
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4366 Vauto_save_list_file_prefix = build_string ("~/.saves-");
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4367
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4368 DEFVAR_BOOL ("inhibit-auto-save-session", &inhibit_auto_save_session /*
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4369 When non-nil, inhibit auto save list file creation.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4370 */ );
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4371 inhibit_auto_save_session = 0;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4372
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4373 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4374 &disable_auto_save_when_buffer_shrinks /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4375 If non-nil, auto-saving is disabled when a buffer shrinks too much.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4376 This is to prevent you from losing your edits if you accidentally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4377 delete a large chunk of the buffer and don't notice it until too late.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4378 Saving the buffer normally turns auto-save back on.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4379 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4380 disable_auto_save_when_buffer_shrinks = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4382 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4383 Directory separator character for built-in functions that return file names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4384 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4385 This variable affects the built-in functions only on Windows,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4386 on other platforms, it is initialized so that Lisp code can find out
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4387 what the normal separator is.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4388 */ );
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4389 Vdirectory_sep_char = make_char (DEFAULT_DIRECTORY_SEP);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4390
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4391 reinit_vars_of_fileio ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4392 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4393
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4394 void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4395 reinit_vars_of_fileio (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4396 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4397 /* We want temp_name_rand to be initialized to a value likely to be
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4398 unique to the process, not to the executable. The danger is that
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4399 two different XEmacs processes using the same binary on different
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4400 machines creating temp files in the same directory will be
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4401 unlucky enough to have the same pid. If we randomize using
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4402 process startup time, then in practice they will be unlikely to
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4403 collide. We use the microseconds field so that scripts that start
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4404 simultaneous XEmacs processes on multiple machines will have less
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4405 chance of collision. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4406 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4407 EMACS_TIME thyme;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4408
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4409 EMACS_GET_TIME (thyme);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4410 temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4411 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4412 }