annotate src/fileio.c @ 665:fdefd0186b75

[xemacs-hg @ 2001-09-20 06:28:42 by ben] The great integral types renaming. The purpose of this is to rationalize the names used for various integral types, so that they match their intended uses and follow consist conventions, and eliminate types that were not semantically different from each other. The conventions are: -- All integral types that measure quantities of anything are signed. Some people disagree vociferously with this, but their arguments are mostly theoretical, and are vastly outweighed by the practical headaches of mixing signed and unsigned values, and more importantly by the far increased likelihood of inadvertent bugs: Because of the broken "viral" nature of unsigned quantities in C (operations involving mixed signed/unsigned are done unsigned, when exactly the opposite is nearly always wanted), even a single error in declaring a quantity unsigned that should be signed, or even the even more subtle error of comparing signed and unsigned values and forgetting the necessary cast, can be catastrophic, as comparisons will yield wrong results. -Wsign-compare is turned on specifically to catch this, but this tends to result in a great number of warnings when mixing signed and unsigned, and the casts are annoying. More has been written on this elsewhere. -- All such quantity types just mentioned boil down to EMACS_INT, which is 32 bits on 32-bit machines and 64 bits on 64-bit machines. This is guaranteed to be the same size as Lisp objects of type `int', and (as far as I can tell) of size_t (unsigned!) and ssize_t. The only type below that is not an EMACS_INT is Hashcode, which is an unsigned value of the same size as EMACS_INT. -- Type names should be relatively short (no more than 10 characters or so), with the first letter capitalized and no underscores if they can at all be avoided. -- "count" == a zero-based measurement of some quantity. Includes sizes, offsets, and indexes. -- "bpos" == a one-based measurement of a position in a buffer. "Charbpos" and "Bytebpos" count text in the buffer, rather than bytes in memory; thus Bytebpos does not directly correspond to the memory representation. Use "Membpos" for this. -- "Char" refers to internal-format characters, not to the C type "char", which is really a byte. -- For the actual name changes, see the script below. I ran the following script to do the conversion. (NOTE: This script is idempotent. You can safely run it multiple times and it will not screw up previous results -- in fact, it will do nothing if nothing has changed. Thus, it can be run repeatedly as necessary to handle patches coming in from old workspaces, or old branches.) There are two tags, just before and just after the change: `pre-integral-type-rename' and `post-integral-type-rename'. When merging code from the main trunk into a branch, the best thing to do is first merge up to `pre-integral-type-rename', then apply the script and associated changes, then merge from `post-integral-type-change' to the present. (Alternatively, just do the merging in one operation; but you may then have a lot of conflicts needing to be resolved by hand.) Script `fixtypes.sh' follows: ----------------------------------- cut ------------------------------------ files="*.[ch] s/*.h m/*.h config.h.in ../configure.in Makefile.in.in ../lib-src/*.[ch] ../lwlib/*.[ch]" gr Memory_Count Bytecount $files gr Lstream_Data_Count Bytecount $files gr Element_Count Elemcount $files gr Hash_Code Hashcode $files gr extcount bytecount $files gr bufpos charbpos $files gr bytind bytebpos $files gr memind membpos $files gr bufbyte intbyte $files gr Extcount Bytecount $files gr Bufpos Charbpos $files gr Bytind Bytebpos $files gr Memind Membpos $files gr Bufbyte Intbyte $files gr EXTCOUNT BYTECOUNT $files gr BUFPOS CHARBPOS $files gr BYTIND BYTEBPOS $files gr MEMIND MEMBPOS $files gr BUFBYTE INTBYTE $files gr MEMORY_COUNT BYTECOUNT $files gr LSTREAM_DATA_COUNT BYTECOUNT $files gr ELEMENT_COUNT ELEMCOUNT $files gr HASH_CODE HASHCODE $files ----------------------------------- cut ------------------------------------ `fixtypes.sh' is a Bourne-shell script; it uses 'gr': ----------------------------------- cut ------------------------------------ #!/bin/sh # Usage is like this: # gr FROM TO FILES ... # globally replace FROM with TO in FILES. FROM and TO are regular expressions. # backup files are stored in the `backup' directory. from="$1" to="$2" shift 2 echo ${1+"$@"} | xargs global-replace "s/$from/$to/g" ----------------------------------- cut ------------------------------------ `gr' in turn uses a Perl script to do its real work, `global-replace', which follows: ----------------------------------- cut ------------------------------------ : #-*- Perl -*- ### global-modify --- modify the contents of a file by a Perl expression ## Copyright (C) 1999 Martin Buchholz. ## Copyright (C) 2001 Ben Wing. ## Authors: Martin Buchholz <martin@xemacs.org>, Ben Wing <ben@xemacs.org> ## Maintainer: Ben Wing <ben@xemacs.org> ## Current Version: 1.0, May 5, 2001 # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with XEmacs; see the file COPYING. If not, write to the Free # Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. eval 'exec perl -w -S $0 ${1+"$@"}' if 0; use strict; use FileHandle; use Carp; use Getopt::Long; use File::Basename; (my $myName = $0) =~ s@.*/@@; my $usage=" Usage: $myName [--help] [--backup-dir=DIR] [--line-mode] [--hunk-mode] PERLEXPR FILE ... Globally modify a file, either line by line or in one big hunk. Typical usage is like this: [with GNU print, GNU xargs: guaranteed to handle spaces, quotes, etc. in file names] find . -name '*.[ch]' -print0 | xargs -0 $0 's/\bCONST\b/const/g'\n [with non-GNU print, xargs] find . -name '*.[ch]' -print | xargs $0 's/\bCONST\b/const/g'\n The file is read in, either line by line (with --line-mode specified) or in one big hunk (with --hunk-mode specified; it's the default), and the Perl expression is then evalled with \$_ set to the line or hunk of text, including the terminating newline if there is one. It should destructively modify the value there, storing the changed result in \$_. Files in which any modifications are made are backed up to the directory specified using --backup-dir, or to `backup' by default. To disable this, use --backup-dir= with no argument. Hunk mode is the default because it is MUCH MUCH faster than line-by-line. Use line-by-line only when it matters, e.g. you want to do a replacement only once per line (the default without the `g' argument). Conversely, when using hunk mode, *ALWAYS* use `g'; otherwise, you will only make one replacement in the entire file! "; my %options = (); $Getopt::Long::ignorecase = 0; &GetOptions ( \%options, 'help', 'backup-dir=s', 'line-mode', 'hunk-mode', ); die $usage if $options{"help"} or @ARGV <= 1; my $code = shift; die $usage if grep (-d || ! -w, @ARGV); sub SafeOpen { open ((my $fh = new FileHandle), $_[0]); confess "Can't open $_[0]: $!" if ! defined $fh; return $fh; } sub SafeClose { close $_[0] or confess "Can't close $_[0]: $!"; } sub FileContents { my $fh = SafeOpen ("< $_[0]"); my $olddollarslash = $/; local $/ = undef; my $contents = <$fh>; $/ = $olddollarslash; return $contents; } sub WriteStringToFile { my $fh = SafeOpen ("> $_[0]"); binmode $fh; print $fh $_[1] or confess "$_[0]: $!\n"; SafeClose $fh; } foreach my $file (@ARGV) { my $changed_p = 0; my $new_contents = ""; if ($options{"line-mode"}) { my $fh = SafeOpen $file; while (<$fh>) { my $save_line = $_; eval $code; $changed_p = 1 if $save_line ne $_; $new_contents .= $_; } } else { my $orig_contents = $_ = FileContents $file; eval $code; if ($_ ne $orig_contents) { $changed_p = 1; $new_contents = $_; } } if ($changed_p) { my $backdir = $options{"backup-dir"}; $backdir = "backup" if !defined ($backdir); if ($backdir) { my ($name, $path, $suffix) = fileparse ($file, ""); my $backfulldir = $path . $backdir; my $backfile = "$backfulldir/$name"; mkdir $backfulldir, 0755 unless -d $backfulldir; print "modifying $file (original saved in $backfile)\n"; rename $file, $backfile; } WriteStringToFile ($file, $new_contents); } } ----------------------------------- cut ------------------------------------ In addition to those programs, I needed to fix up a few other things, particularly relating to the duplicate definitions of types, now that some types merged with others. Specifically: 1. in lisp.h, removed duplicate declarations of Bytecount. The changed code should now look like this: (In each code snippet below, the first and last lines are the same as the original, as are all lines outside of those lines. That allows you to locate the section to be replaced, and replace the stuff in that section, verifying that there isn't anything new added that would need to be kept.) --------------------------------- snip ------------------------------------- /* Counts of bytes or chars */ typedef EMACS_INT Bytecount; typedef EMACS_INT Charcount; /* Counts of elements */ typedef EMACS_INT Elemcount; /* Hash codes */ typedef unsigned long Hashcode; /* ------------------------ dynamic arrays ------------------- */ --------------------------------- snip ------------------------------------- 2. in lstream.h, removed duplicate declaration of Bytecount. Rewrote the comment about this type. The changed code should now look like this: --------------------------------- snip ------------------------------------- #endif /* The have been some arguments over the what the type should be that specifies a count of bytes in a data block to be written out or read in, using Lstream_read(), Lstream_write(), and related functions. Originally it was long, which worked fine; Martin "corrected" these to size_t and ssize_t on the grounds that this is theoretically cleaner and is in keeping with the C standards. Unfortunately, this practice is horribly error-prone due to design flaws in the way that mixed signed/unsigned arithmetic happens. In fact, by doing this change, Martin introduced a subtle but fatal error that caused the operation of sending large mail messages to the SMTP server under Windows to fail. By putting all values back to be signed, avoiding any signed/unsigned mixing, the bug immediately went away. The type then in use was Lstream_Data_Count, so that it be reverted cleanly if a vote came to that. Now it is Bytecount. Some earlier comments about why the type must be signed: This MUST BE SIGNED, since it also is used in functions that return the number of bytes actually read to or written from in an operation, and these functions can return -1 to signal error. Note that the standard Unix read() and write() functions define the count going in as a size_t, which is UNSIGNED, and the count going out as an ssize_t, which is SIGNED. This is a horrible design flaw. Not only is it highly likely to lead to logic errors when a -1 gets interpreted as a large positive number, but operations are bound to fail in all sorts of horrible ways when a number in the upper-half of the size_t range is passed in -- this number is unrepresentable as an ssize_t, so code that checks to see how many bytes are actually written (which is mandatory if you are dealing with certain types of devices) will get completely screwed up. --ben */ typedef enum lstream_buffering --------------------------------- snip ------------------------------------- 3. in dumper.c, there are four places, all inside of switch() statements, where XD_BYTECOUNT appears twice as a case tag. In each case, the two case blocks contain identical code, and you should *REMOVE THE SECOND* and leave the first.
author ben
date Thu, 20 Sep 2001 06:31:11 +0000
parents 6e99cc8c6ca5
children a307f9a2021d
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.
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3 Copyright (C) 1996, 2001 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. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* More syncing: FSF Emacs 19.34.6 by Marc Paquette <marcpa@cam.org> */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 #include "events.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "insdel.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "lstream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "redisplay.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "sysdep.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "window.h" /* minibuf_level */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #ifdef FILE_CODING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "file-coding.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #ifdef HAVE_LIBGEN_H /* Must come before sysfile.h */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 #include <libgen.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 #include "sysfile.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 #include "sysproc.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #include "syspwd.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #include "systime.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #include "sysdir.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #ifdef HPUX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 #include <netio.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 #ifdef HPUX_PRE_8_0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 #include <errnet.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 #endif /* HPUX_PRE_8_0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 #endif /* HPUX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
56 #if defined(WIN32_NATIVE) || defined(CYGWIN)
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
57 #define WIN32_FILENAMES
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
58 #ifdef WIN32_NATIVE
592
4f6ba8f1fb3d [xemacs-hg @ 2001-05-31 12:03:37 by adrian]
adrian
parents: 563
diff changeset
59 #include "nt.h"
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
60 #endif /* WIN32_NATIVE */
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 #ifndef CORRECT_DIR_SEPS
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
67 #define CORRECT_DIR_SEPS(s) \
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
68 normalize_filename(s, DIRECTORY_SEP)
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
69 /* Default implementation that coerces a file to use path_sep. */
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
70 static void
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
71 normalize_filename (Intbyte *fp, Intbyte path_sep)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
72 {
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
73 /* Always lower-case drive letters a-z, even if the filesystem
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
74 preserves case in filenames.
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
75 This is so filenames can be compared by string comparison
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
76 functions that are case-sensitive. Even case-preserving filesystems
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
77 do not distinguish case in drive letters. */
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
78 if (fp[1] == ':' && *fp >= 'A' && *fp <= 'Z')
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
79 {
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
80 *fp += 'a' - 'A';
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
81 fp += 2;
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
82 }
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
83
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
84 while (*fp)
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
85 {
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
86 if (*fp == '/' || *fp == '\\')
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
87 *fp = path_sep;
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
88 fp++;
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
89 }
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
90 }
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
91 #endif /* CORRECT_DIR_SEPS */
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
92 #endif /* WIN32_NATIVE || CYGWIN */
428
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 int lisp_to_time (Lisp_Object, time_t *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 Lisp_Object time_to_lisp (time_t);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 /* Nonzero during writing of auto-save files */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 static int auto_saving;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 /* 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
101 will create a new file with the same mode as the original */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 static int auto_save_mode_bits;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 /* Alist of elements (REGEXP . HANDLER) for file names
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 whose I/O is done with a special handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 Lisp_Object Vfile_name_handler_alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 /* Format for auto-save files */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 Lisp_Object Vauto_save_file_format;
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 /* Lisp functions for translating file formats */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 Lisp_Object Qformat_decode, Qformat_annotate_function;
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 /* Functions to be called to process text properties in inserted file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 Lisp_Object Vafter_insert_file_functions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 /* Functions to be called to create text property annotations for file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 Lisp_Object Vwrite_region_annotate_functions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 /* During build_annotations, each time an annotation function is called,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 this holds the annotations made by the previous functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 Lisp_Object Vwrite_region_annotations_so_far;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 /* 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
125 Lisp_Object Vauto_save_list_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
127 /* Prefix used to construct Vauto_save_list_file_name. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
128 Lisp_Object Vauto_save_list_file_prefix;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
129
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
130 /* When non-nil, it prevents auto-save list file creation. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
131 int inhibit_auto_save_session;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
132
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 int disable_auto_save_when_buffer_shrinks;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 Lisp_Object Vdirectory_sep_char;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 /* These variables describe handlers that have "already" had a chance
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 to handle the current operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 Vinhibit_file_name_handlers is a list of file name handlers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 Vinhibit_file_name_operation is the operation being handled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 If we try to handle that operation, we ignore those handlers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 static Lisp_Object Vinhibit_file_name_handlers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 static Lisp_Object Vinhibit_file_name_operation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
147 Lisp_Object Qfile_already_exists;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 Lisp_Object Qauto_save_hook;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 Lisp_Object Qauto_save_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 Lisp_Object Qauto_saving;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 Lisp_Object Qcar_less_than_car;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 Lisp_Object Qcompute_buffer_file_truename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 EXFUN (Frunning_temacs_p, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
159 /* DATA can be anything acceptable to signal_error ().
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
160 */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
161
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
162 DOESNT_RETURN
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
163 report_file_type_error (Lisp_Object errtype, Lisp_Object oserrmess,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
164 const CIntbyte *string, Lisp_Object data)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
165 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
166 struct gcpro gcpro1;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
167 Lisp_Object errdata = build_error_data (NULL, data);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
168
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
169 GCPRO1 (errdata);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
170 errdata = Fcons (build_translated_string (string),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
171 Fcons (oserrmess, errdata));
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
172 signal_error_1 (errtype, errdata);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
173 UNGCPRO; /* not reached */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
174 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
175
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
176 DOESNT_RETURN
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
177 report_error_with_errno (Lisp_Object errtype,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
178 const CIntbyte *string, Lisp_Object data)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
179 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
180 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
181 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
182
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 /* signal a file error when errno contains a meaningful value. */
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 DOESNT_RETURN
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
186 report_file_error (const CIntbyte *string, Lisp_Object data)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
188 report_error_with_errno (Qfile_error, string, data);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190
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 /* Just like strerror(3), except return a lisp string instead of char *.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 The string needs to be converted since it may be localized.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 Perhaps this should use strerror-coding-system instead? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 lisp_strerror (int errnum)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
198 return build_ext_string (strerror (errnum), Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 close_file_unwind (Lisp_Object fd)
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 if (CONSP (fd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 if (INTP (XCAR (fd)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 close (XINT (XCAR (fd)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 free_cons (XCONS (fd));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 close (XINT (fd));
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 delete_stream_unwind (Lisp_Object stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 Lstream_delete (XLSTREAM (stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 /* Restore point, having saved it as a marker. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 restore_point_unwind (Lisp_Object point_marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 BUF_SET_PT (current_buffer, marker_position (point_marker));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 return Fset_marker (point_marker, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 /* Versions of read() and write() that allow quitting out of the actual
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 I/O. We don't use immediate_quit (i.e. direct longjmp() out of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 signal handler) because that's way too losing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 (#### Actually, longjmp()ing out of the signal handler may not be
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 609
diff changeset
238 as losing as I thought. See qxe_reliable_signal() in sysdep.c.) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
240 Bytecount
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
241 read_allowing_quit (int fildes, void *buf, Bytecount size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 return sys_read_1 (fildes, buf, size, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
247 Bytecount
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
248 write_allowing_quit (int fildes, const void *buf, Bytecount size)
428
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 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 return sys_write_1 (fildes, buf, size, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 Lisp_Object Qexpand_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 Lisp_Object Qfile_truename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 Lisp_Object Qsubstitute_in_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 Lisp_Object Qdirectory_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 Lisp_Object Qfile_name_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 Lisp_Object Qfile_name_nondirectory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 Lisp_Object Qunhandled_file_name_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 Lisp_Object Qfile_name_as_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 Lisp_Object Qcopy_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 Lisp_Object Qmake_directory_internal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 Lisp_Object Qdelete_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 Lisp_Object Qdelete_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 Lisp_Object Qrename_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 Lisp_Object Qadd_name_to_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 Lisp_Object Qmake_symbolic_link;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 Lisp_Object Qfile_exists_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 Lisp_Object Qfile_executable_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 Lisp_Object Qfile_readable_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 Lisp_Object Qfile_symlink_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 Lisp_Object Qfile_writable_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 Lisp_Object Qfile_directory_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 Lisp_Object Qfile_regular_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 Lisp_Object Qfile_accessible_directory_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 Lisp_Object Qfile_modes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 Lisp_Object Qset_file_modes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 Lisp_Object Qfile_newer_than_file_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 Lisp_Object Qinsert_file_contents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 Lisp_Object Qwrite_region;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 Lisp_Object Qverify_visited_file_modtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 Lisp_Object Qset_visited_file_modtime;
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 /* If FILENAME is handled specially on account of its syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 return its handler function. Otherwise, return nil. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 DEFUN ("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 Return FILENAME's handler function for OPERATION, if it has one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 Otherwise, return nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 A file name is handled if one of the regular expressions in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 `file-name-handler-alist' matches it.
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 If OPERATION equals `inhibit-file-name-operation', then we ignore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 any handlers that are members of `inhibit-file-name-handlers',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 but we still do run any other handlers. This lets handlers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 use the standard functions without calling themselves recursively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 (filename, operation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 /* This function does not GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 /* This function can be called during GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 /* This function must not munge the match data. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 Lisp_Object chain, inhibited_handlers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 if (EQ (operation, Vinhibit_file_name_operation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 inhibited_handlers = Vinhibit_file_name_handlers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 inhibited_handlers = Qnil;
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 EXTERNAL_LIST_LOOP (chain, Vfile_name_handler_alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 Lisp_Object elt = XCAR (chain);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 if (CONSP (elt))
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 Lisp_Object string = XCAR (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 if (STRINGP (string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 && (fast_lisp_string_match (string, filename) >= 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 Lisp_Object handler = XCDR (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 if (NILP (Fmemq (handler, inhibited_handlers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 return handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 call2_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 Lisp_Object result = call2 (fn, arg0, arg1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 CHECK_STRING (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 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
344 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 Lisp_Object result = call2 (fn, arg0, arg1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 if (!NILP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 CHECK_STRING (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 call3_check_string (Lisp_Object fn, Lisp_Object arg0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 Lisp_Object arg1, Lisp_Object arg2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 Lisp_Object result = call3 (fn, arg0, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 CHECK_STRING (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
364 Return the directory component in file name FILENAME.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
365 Return nil if FILENAME does not include a directory.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 Otherwise return a directory spec.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 Given a Unix syntax file name, returns a string ending in slash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
369 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
371 /* This function can GC. GC checked 2000-07-28 ben */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
372 Intbyte *beg;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
373 Intbyte *p;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
376 CHECK_STRING (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
380 handler = Ffind_file_name_handler (filename, Qfile_name_directory);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
382 return call2_check_string_or_nil (handler, Qfile_name_directory, filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 #ifdef FILE_SYSTEM_CASE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
385 filename = FILE_SYSTEM_CASE (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
387 beg = XSTRING_DATA (filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
388 p = beg + XSTRING_LENGTH (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 while (p != beg && !IS_ANY_SEP (p[-1])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
391 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 /* only recognize drive specifier at beginning */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 && !(p[-1] == ':' && p == beg + 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 ) p--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 if (p == beg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 return Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
399 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 /* Expansion of "c:" to drive and default directory. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 /* (NT does the right thing.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 if (p == beg + 2 && beg[1] == ':')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
405 Intbyte *res = (Intbyte*) alloca (MAXPATHLEN + 1);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
406 if (_getdcwd (toupper (*beg) - 'A' + 1, (char *)res, MAXPATHLEN))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 char *c=((char *) res) + strlen ((char *) res);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 if (!IS_DIRECTORY_SEP (*c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 *c++ = DIRECTORY_SEP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 *c = '\0';
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 beg = res;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 p = beg + strlen ((char *) beg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
418 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 return make_string (beg, p - beg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
423 Return file name FILENAME sans its directory.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 For example, in a Unix-syntax file name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 this is everything after the last slash,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 or the entire name if it contains no slash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
428 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
430 /* This function can GC. GC checked 2000-07-28 ben */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
431 Intbyte *beg, *p, *end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
434 CHECK_STRING (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
438 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
440 return call2_check_string (handler, Qfile_name_nondirectory, filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
441
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
442 beg = XSTRING_DATA (filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
443 end = p = beg + XSTRING_LENGTH (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 while (p != beg && !IS_ANY_SEP (p[-1])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
446 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 /* only recognize drive specifier at beginning */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 && !(p[-1] == ':' && p == beg + 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 ) p--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 return make_string (p, end - p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 Return a directly usable directory name somehow associated with FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 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
458 intervention of any file handler.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 If FILENAME is a directly usable file itself, return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 \(file-name-directory FILENAME).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 The `call-process' and `start-process' functions use this function to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 get a current directory to run processes in.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
464 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
466 /* This function can GC. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 return call2 (handler, Qunhandled_file_name_directory,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 return Ffile_name_directory (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 static char *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 file_name_as_directory (char *out, char *in)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
483 /* This function cannot GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 int size = strlen (in);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 if (size == 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 out[0] = '.';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 out[1] = DIRECTORY_SEP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 out[2] = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 else
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 strcpy (out, in);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 /* Append a slash if necessary */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 if (!IS_ANY_SEP (out[size-1]))
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 out[size] = DIRECTORY_SEP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 out[size + 1] = '\0';
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 return out;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 Return a string representing file FILENAME interpreted as a directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 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
508 a directory is different from its name as a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 The result can be used as the value of `default-directory'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 or passed as second argument to `expand-file-name'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 For a Unix-syntax file name, just appends a slash,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 except for (file-name-as-directory \"\") => \"./\".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
514 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
516 /* This function can GC. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 char *buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
520 CHECK_STRING (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
524 handler = Ffind_file_name_handler (filename, Qfile_name_as_directory);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
526 return call2_check_string (handler, Qfile_name_as_directory, filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
527
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
528 buf = (char *) alloca (XSTRING_LENGTH (filename) + 10);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 return build_string (file_name_as_directory
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
530 (buf, (char *) XSTRING_DATA (filename)));
428
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
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 * Convert from directory name to filename.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 * 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
536 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 * Value is nonzero if the string output is different from the input.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 static int
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
541 directory_file_name (const char *src, char *dst)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
543 /* This function cannot GC */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
544 long slen = strlen (src);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 /* Process as Unix format: just remove any final slash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 But leave "/" unchanged; do not change it to "". */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 strcpy (dst, src);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 if (slen > 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 && IS_DIRECTORY_SEP (dst[slen - 1])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
550 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 && !IS_ANY_SEP (dst[slen - 2])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
552 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 dst[slen - 1] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
559 Return the file name of the directory named DIRECTORY.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
560 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
561 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
562 a directory is different from its name as a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 In Unix-syntax, this function just removes the final slash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 (directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
567 /* This function can GC. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 char *buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 CHECK_STRING (directory);
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 0 /* #### WTF? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 if (NILP (directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 return call2_check_string (handler, Qdirectory_file_name, directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 buf = (char *) alloca (XSTRING_LENGTH (directory) + 20);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 directory_file_name ((char *) XSTRING_DATA (directory), buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 return build_string (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 }
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 /* 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
589 proved too broken for our purposes (it supported only 26 or 62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 unique names under some implementations). For example, this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 arbitrary limit broke generation of Gnus Incoming* files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 This implementation is better than what one usually finds in libc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 --hniksic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
596 static unsigned int temp_name_rand;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
597
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
599 Generate a temporary file name starting with PREFIX.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 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
601 danger of generating a name being used by another process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 In addition, this function makes an attempt to choose a name that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 does not specify an existing file. To make this work, PREFIX should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 be an absolute file name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 (prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
609 static const char tbl[64] =
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
610 {
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 'A','B','C','D','E','F','G','H',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 'I','J','K','L','M','N','O','P',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 'Q','R','S','T','U','V','W','X',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 'Y','Z','a','b','c','d','e','f',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 'g','h','i','j','k','l','m','n',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 'o','p','q','r','s','t','u','v',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 'w','x','y','z','0','1','2','3',
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
618 '4','5','6','7','8','9','-','_'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
619 };
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 Bytecount len;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
623 Intbyte *p, *data;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 CHECK_STRING (prefix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 /* 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
628 a bad idea because:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 1) It might change the prefix, so the resulting string might not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 begin with PREFIX. This violates the principle of least
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 surprise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 2) It breaks under many unforeseeable circumstances, such as with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 the code that uses (make-temp-name "") instead of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 (make-temp-name "./").
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 3) It might yield unexpected (to stat(2)) results in the presence
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 of EFS and file name handlers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 len = XSTRING_LENGTH (prefix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 val = make_uninit_string (len + 6);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 data = XSTRING_DATA (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 memcpy (data, XSTRING_DATA (prefix), len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 p = data + len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 /* VAL is created by adding 6 characters to PREFIX. The first three
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 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
649 a pseudo-random number seeded from process startup time. This
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
650 ensures 262144 unique file names per PID per PREFIX per machine. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
651
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
652 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
653 unsigned int pid = (unsigned int) getpid ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
654 *p++ = tbl[(pid >> 0) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
655 *p++ = tbl[(pid >> 6) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
656 *p++ = tbl[(pid >> 12) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
657 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 /* Here we try to minimize useless stat'ing when this function is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 invoked many times successively with the same PREFIX. We achieve
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
661 this by using a very pseudo-random number generator to generate
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
662 file names unique to this process, with a very long cycle. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 struct stat ignored;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
667
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
668 p[0] = tbl[(temp_name_rand >> 0) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
669 p[1] = tbl[(temp_name_rand >> 6) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
670 p[2] = tbl[(temp_name_rand >> 12) & 63];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 /* Poor man's congruential RN generator. Replace with ++count
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 for debugging. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
674 temp_name_rand += 25229;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
675 temp_name_rand %= 225307;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
679 if (xemacs_stat ((const char *) data, &ignored) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 /* We want to return only if errno is ENOENT. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 if (errno == ENOENT)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 /* The error here is dubious, but there is little else we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 can do. The alternatives are to return nil, which is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 as bad as (and in many cases worse than) throwing the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 error, or to ignore the error, which will likely result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 in inflooping. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 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
691 prefix);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 return Qnil; /* not reached */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 }
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 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 Convert filename NAME to absolute, and canonicalize it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 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
701 (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
702 the current buffer's value of `default-directory' is used.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 File name components that are `.' are removed, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 so are file name components followed by `..', along with the `..' itself;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 note that these simplifications are done without checking the resulting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 file names in the file system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 An initial `~/' expands to your home directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 An initial `~USER/' expands to USER's home directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 See also the function `substitute-in-file-name'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 (name, default_directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
713 /* This function can GC. GC-checked 2000-11-18 */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
714 Intbyte *nm;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
715
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
716 Intbyte *newdir, *p, *o;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 int tlen;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
718 Intbyte *target;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
719 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 int drive = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 int collapse_newdir = 1;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
722 #endif
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
723 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 struct passwd *pw;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
725 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 int length;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
727 Lisp_Object handler = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
728 #ifdef CYGWIN
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 char *user;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 #endif
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
731 struct gcpro gcpro1, gcpro2, gcpro3;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
732
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
733 /* both of these get set below */
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
734 GCPRO3 (name, default_directory, handler);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 CHECK_STRING (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 handler = Ffind_file_name_handler (name, Qexpand_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 if (!NILP (handler))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
742 RETURN_UNGCPRO (call3_check_string (handler, Qexpand_file_name,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
743 name, default_directory));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 if (NILP (default_directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 default_directory = current_buffer->directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 if (! STRINGP (default_directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 default_directory = build_string ("/");
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 if (!NILP (default_directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 if (!NILP (handler))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
755 RETURN_UNGCPRO (call3 (handler, Qexpand_file_name,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
756 name, default_directory));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 o = XSTRING_DATA (default_directory);
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 /* Make sure DEFAULT_DIRECTORY is properly expanded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 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
763 default_directory. Unfortunately, calling Fexpand_file_name recursively
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 could invoke GC, and the strings might be relocated. This would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 be annoying because we have pointers into strings lying around
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 that would need adjusting, and people would add new pointers to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 the code and forget to adjust them, resulting in intermittent bugs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 Putting this call here avoids all that crud.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 The EQ test avoids infinite recursion. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 if (! NILP (default_directory) && !EQ (default_directory, name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 /* Save time in some common cases - as long as default_directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 is not relative, it can be canonicalized with name below (if it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 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
775 #ifdef WIN32_FILENAMES
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
776 /* Detect Windows file names with drive specifiers. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 && ! (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
778 /* Detect Windows file names in UNC format. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 && ! (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
780 #endif /* not WIN32_FILENAMES */
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
781 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 /* Detect Unix absolute file names (/... alone is not absolute on
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
783 Windows). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 && ! (IS_DIRECTORY_SEP (o[0]))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
785 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 )
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
787
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
788 default_directory = Fexpand_file_name (default_directory, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 #ifdef FILE_SYSTEM_CASE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 name = FILE_SYSTEM_CASE (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 into name should be safe during all of this, though. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 nm = XSTRING_DATA (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
798 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 /* We will force directory separators to be either all \ or /, so make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 a local copy to modify, even if there ends up being no change. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
801 nm = (Intbyte *) strcpy ((char *) alloca (strlen ((char *) nm) + 1),
664
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 657
diff changeset
802 (char *) nm);
428
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 /* Find and remove drive specifier if present; this makes nm absolute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 even if the rest of the name appears to be relative. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
807 Intbyte *colon = (Intbyte *) strrchr ((char *)nm, ':');
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 if (colon)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
810 {
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 /* Only recognize colon as part of drive specifier if there is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 single alphabetic character preceding the colon (and if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 character before the drive letter, if present, is a directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 separator); this is to support the remote system syntax used by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 ange-ftp, and the "po:username" syntax for POP mailboxes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 look_again:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 if (nm == colon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 nm++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 else if (IS_DRIVE (colon[-1])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 drive = colon[-1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 nm = colon + 1;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 while (--colon >= nm)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 if (colon[0] == ':')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 goto look_again;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
831 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 /* 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
835 colon when stripping the drive letter. Otherwise, this expands to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 "//somedir". */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 nm++;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
839 #endif /* WIN32_FILENAMES */
428
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 /* If nm is absolute, look for /./ or /../ sequences; if none are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 found, we can probably return right away. We will avoid allocating
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 a new string if name is already fully expanded. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 if (
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 IS_DIRECTORY_SEP (nm[0])
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
846 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 && (drive || IS_DIRECTORY_SEP (nm[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 #endif
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 /* 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
852 suffix of FILENAME, we don't need to go through and edit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 things; we just need to construct a new string using data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 starting at the middle of FILENAME. If we set lose to a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 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
856 that cool trick. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 int lose = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 p = nm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 while (*p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 /* Since we know the name is absolute, we can assume that each
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 element starts with a "/". */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 /* "." and ".." are hairy. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 if (IS_DIRECTORY_SEP (p[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 && p[1] == '.'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 && (IS_DIRECTORY_SEP (p[2])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 || p[2] == 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 || p[3] == 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 lose = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 p++;
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 (!lose)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 {
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
877 #ifdef WIN32_FILENAMES
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
878 if (drive || IS_DIRECTORY_SEP (nm[1]))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 {
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
880 /* Make sure directories are all separated with / or \ as
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
881 desired, but avoid allocation of a new string when not
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
882 required. */
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
883 CORRECT_DIR_SEPS (nm);
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
884 if (IS_DIRECTORY_SEP (nm[1]))
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
885 {
664
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 657
diff changeset
886 if (strcmp ((char *) nm, (char *) XSTRING_DATA (name)) != 0)
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
887 name = build_string ((CIntbyte *) nm);
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
888 }
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
889 /* drive must be set, so this is okay */
664
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 657
diff changeset
890 else if (strcmp ((char *) nm - 2,
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 657
diff changeset
891 (char *) XSTRING_DATA (name)) != 0)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
892 {
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
893 name = make_string (nm - 2, p - nm + 2);
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
894 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
895 XSTRING_DATA (name)[1] = ':';
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
896 }
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
897 RETURN_UNGCPRO (name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
899 #endif /* not WIN32_FILENAMES */
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
900 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 if (nm == XSTRING_DATA (name))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
902 RETURN_UNGCPRO (name);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
903 RETURN_UNGCPRO (build_string ((char *) nm));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
904 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 /* 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
909 need to expand ~ or ~user if present, otherwise prefix nm with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 default_directory if nm is not absolute, and finally collapse /./
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 and /foo/../ sequences.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 We set newdir to be the appropriate prefix if one is needed:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 - the relevant user directory if nm starts with ~ or ~user
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 - 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
916 start with /
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 - the value of default_directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 Note that these prefixes are not guaranteed to be absolute (except
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 for the working dir of a drive). Therefore, to ensure we always
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 return an absolute name, if the final prefix is not absolute we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 append it to the current working directory. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 newdir = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 if (nm[0] == '~') /* prefix ~ */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 if (IS_DIRECTORY_SEP (nm[1])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 || nm[1] == 0) /* ~ by itself */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
931 Extbyte *newdir_external = get_home_directory ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 if (newdir_external == NULL)
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
934 newdir = (Intbyte *) "";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 else
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
936 TO_INTERNAL_FORMAT (C_STRING, newdir_external,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
937 C_STRING_ALLOCA, (* ((char **) &newdir)),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
938 Qfile_name);
428
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 nm++;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
941 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 collapse_newdir = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 else /* ~user/filename */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 DO_NOTHING;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
949 o = (Intbyte *) alloca (p - nm + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 memcpy (o, (char *) nm, p - nm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 o [p - nm] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 462
diff changeset
953 /* #### 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
954 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
955 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
956 ~user. --ben */
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 462
diff changeset
957 #ifndef WIN32_NATIVE
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
958 #ifdef CYGWIN
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 if ((user = user_login_name (NULL)) != NULL)
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 /* Does the user login name match the ~name? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 if (strcmp (user, (char *) o + 1) == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
964 newdir = (Intbyte *) get_home_directory();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 nm = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 if (! newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
970 #endif /* CYGWIN */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 occurring in it. (It can call select()). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 slow_down_interrupts ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 pw = (struct passwd *) getpwnam ((char *) o + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 speed_up_interrupts ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 if (pw)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
978 newdir = (Intbyte *) pw -> pw_dir;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 nm = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
981 #ifdef CYGWIN
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 #endif
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
984 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 /* 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
987 unchanged; don't move nm forward to p. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
991 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 /* 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
993 use the drive's current directory as the prefix if needed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 if (!newdir && drive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 {
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
996 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 /* Get default directory if needed to make nm absolute. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 if (!IS_DIRECTORY_SEP (nm[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1000 newdir = (Intbyte *) alloca (MAXPATHLEN + 1);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1001 if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 newdir = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1004 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 if (!newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 /* Either nm starts with /, or drive isn't mounted. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1008 newdir = (Intbyte *) alloca (4);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 newdir[0] = DRIVE_LETTER (drive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 newdir[1] = ':';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 newdir[2] = '/';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 newdir[3] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1015 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 /* Finally, if no prefix has been specified and nm is not absolute,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 then it must be expanded relative to default_directory. */
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 if (1
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1021 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 /* /... alone is not absolute on DOS and Windows. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 && !IS_DIRECTORY_SEP (nm[0])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1024 #endif
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1025 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 && !newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 newdir = XSTRING_DATA (default_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 }
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_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 if (newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 /* First ensure newdir is an absolute name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 if (
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1038 /* Detect Windows file names with drive specifiers. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 ! (IS_DRIVE (newdir[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 /* Detect Windows file names in UNC format. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 /* Detect drive spec by itself */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 && ! (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
1045 /* Detect unix format. */
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1046 #ifndef WIN32_NATIVE
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1047 && ! (IS_DIRECTORY_SEP (newdir[0]))
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1048 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 /* Effectively, let newdir be (expand-file-name newdir cwd).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 Because of the admonition against calling expand-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 when we have pointers into lisp strings, we accomplish this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 indirectly by prepending newdir to nm if necessary, and using
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 cwd (or the wd of newdir's drive) as the new newdir. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
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 drive = newdir[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 newdir += 2;
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 (!IS_DIRECTORY_SEP (nm[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1064 Intbyte *tmp = (Intbyte *) alloca (strlen ((char *) newdir) +
664
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 657
diff changeset
1065 strlen ((char *) nm) + 2);
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 657
diff changeset
1066 file_name_as_directory ((char *) tmp, (char *) newdir);
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 657
diff changeset
1067 strcat ((char *) tmp, (char *) nm);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 nm = tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 }
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1070 newdir = (Intbyte *) alloca (MAXPATHLEN + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 if (drive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 {
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1073 #ifdef WIN32_NATIVE
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1074 if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1075 #endif
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1076 newdir = (Intbyte *) "/";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 else
664
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 657
diff changeset
1079 getcwd ((char *) newdir, MAXPATHLEN);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 }
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 /* Strip off drive name from prefix, if present. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 drive = newdir[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 newdir += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 /* Keep only a prefix from newdir if nm starts with slash
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 (/ /server/share for UNC, nothing otherwise). */
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1091 if (IS_DIRECTORY_SEP (nm[0])
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1092 #ifndef WIN32_NATIVE
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1093 && IS_DIRECTORY_SEP (nm[1])
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1094 #endif
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1095 && collapse_newdir)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 {
664
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 657
diff changeset
1099 newdir =
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1100 (Intbyte *)
664
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 657
diff changeset
1101 strcpy ((char *) alloca (strlen ((char *) newdir) + 1),
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 657
diff changeset
1102 (char *) newdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 p = newdir + 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 *p = 0;
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 else
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1110 newdir = (Intbyte *) "";
428
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 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1113 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 if (newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 /* Get rid of any slash at the end of newdir, unless newdir is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 just // (an incomplete UNC name). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 length = strlen ((char *) newdir);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 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
1121 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1126 Intbyte *temp = (Intbyte *) alloca (length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 memcpy (temp, newdir, length - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 temp[length - 1] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 newdir = temp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 tlen = length + 1;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 tlen = 0;
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 /* Now concatenate the directory and name to new space in the stack frame */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 tlen += strlen ((char *) nm) + 1;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1138 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 /* Add reserved space for drive name. (The Microsoft x86 compiler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 produces incorrect code if the following two lines are combined.) */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1141 target = (Intbyte *) alloca (tlen + 2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 target += 2;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1143 #else /* not WIN32_FILENAMES */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1144 target = (Intbyte *) alloca (tlen);
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1145 #endif /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 *target = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 if (newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 strcpy ((char *) target, (char *) newdir);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 file_name_as_directory ((char *) target, (char *) newdir);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 strcat ((char *) target, (char *) nm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 /* Now canonicalize by removing /. and /foo/.. if they appear. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 p = target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 o = target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 while (*p)
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 if (!IS_DIRECTORY_SEP (*p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 *o++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 else if (IS_DIRECTORY_SEP (p[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 && p[1] == '.'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 && (IS_DIRECTORY_SEP (p[2])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 || p[2] == 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 /* If "/." is the entire filename, keep the "/". Otherwise,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 just delete the whole "/.". */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 if (o == target && p[2] == '\0')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 *o++ = *p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 p += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 /* `/../' is the "superroot" on certain file systems. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 && o != target
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 /* Keep initial / only if this is the whole name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 ++o;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 p += 3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1194 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 /* if drive is set, we're not dealing with an UNC, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 multiple dir-seps are redundant (and reportedly cause trouble
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 under win95) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 else if (drive && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 ++p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 *o++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 }
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
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1207 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 /* At last, set drive name, except for network file name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 if (drive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 target -= 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 target[0] = DRIVE_LETTER (drive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 target[1] = ':';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1215 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1220 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 CORRECT_DIR_SEPS (target);
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1222 #endif /* WIN32_FILENAMES */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1223
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1224 RETURN_UNGCPRO (make_string (target, o - target));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1228 Return the canonical name of FILENAME.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1229 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
1230 (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
1231 the current buffer's value of `default-directory' is used.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 No component of the resulting pathname will be a symbolic link, as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 in the realpath() function.
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 (filename, default_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1237 /* This function can GC. GC checked 2000-07-28 ben. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 Lisp_Object expanded_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 expanded_name = Fexpand_file_name (filename, default_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 if (!STRINGP (expanded_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 GCPRO1 (expanded_name);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1249
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1250 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1251 Lisp_Object handler =
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1252 Ffind_file_name_handler (expanded_name, Qfile_truename);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1253
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1254 if (!NILP (handler))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1255 RETURN_UNGCPRO
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1256 (call2_check_string (handler, Qfile_truename, expanded_name));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1257 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 char resolved_path[MAXPATHLEN];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 Extbyte *path;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 Extbyte *p;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1263 Bytecount elen;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
1264
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
1265 TO_EXTERNAL_FORMAT (LISP_STRING, expanded_name,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
1266 ALLOCA, (path, elen),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
1267 Qfile_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 p = path;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 if (elen > MAXPATHLEN)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 goto toolong;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1271
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 /* Try doing it all at once. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 /* !! Does realpath() Mule-encapsulate?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 Answer: Nope! So we do it above */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 if (!xrealpath ((char *) path, resolved_path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 /* 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
1278 /* "realpath" is a typically useless, stupid un*x piece of crap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 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
1280 there is no indication provided of how far along the pathname
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 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
1282 partial result returned. What a piece of junk.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1283
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1284 The above comment refers to historical versions of
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1285 realpath(). The Unix98 specs state:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1286
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1287 "On successful completion, realpath() returns a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1288 pointer to the resolved name. Otherwise, realpath()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1289 returns a null pointer and sets errno to indicate the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1290 error, and the contents of the buffer pointed to by
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1291 resolved_name are undefined."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1292
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1293 Since we depend on undocumented semantics of various system realpath()s,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1294 we just use our own version in realpath.c. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1297 Extbyte *pos;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1298
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1299 #ifdef WIN32_FILENAMES
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1300 if (IS_DRIVE (p[0]) && IS_DEVICE_SEP (p[1])
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1301 && IS_DIRECTORY_SEP (p[2]))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1302 /* don't test c: on windows */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1303 p = p+2;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1304 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
1305 /* start after // */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1306 p = p+1;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1307 #endif
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1308 for (pos = p + 1; pos < path + elen; pos++)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1309 if (IS_DIRECTORY_SEP (*pos))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1310 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1311 *(p = pos) = 0;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1312 break;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1313 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1314 if (p != pos)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1315 p = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 if (xrealpath ((char *) path, resolved_path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 if (p)
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1320 *p = DIRECTORY_SEP;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 else if (errno == ENOENT || errno == EACCES)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 /* Failed on this component. Just tack on the rest of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 the string and we are done. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 int rlen = strlen (resolved_path);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 /* "On failure, it returns NULL, sets errno to indicate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 the error, and places in resolved_path the absolute pathname
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 of the path component which could not be resolved." */
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 if (p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 int plen = elen - (p - path);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1339 if (rlen > 1 && IS_DIRECTORY_SEP (resolved_path[rlen - 1]))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 rlen = rlen - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 if (plen + rlen + 1 > countof (resolved_path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 goto toolong;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1345 resolved_path[rlen] = DIRECTORY_SEP;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1356 Lisp_Object resolved_name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 int rlen = strlen (resolved_path);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1358 if (elen > 0 && IS_DIRECTORY_SEP (XSTRING_BYTE (expanded_name, elen - 1))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1359 && !(rlen > 0 && IS_DIRECTORY_SEP (resolved_path[rlen - 1])))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 if (rlen + 1 > countof (resolved_path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 goto toolong;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1363 resolved_path[rlen++] = DIRECTORY_SEP;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1364 resolved_path[rlen] = '\0';
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1366 TO_INTERNAL_FORMAT (DATA, (resolved_path, rlen),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1367 LISP_STRING, resolved_name,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1368 Qfile_name);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1369 RETURN_UNGCPRO (resolved_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 toolong:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 errno = ENAMETOOLONG;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 lose:
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1376 report_file_error ("Finding truename", expanded_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1378 RETURN_UNGCPRO (Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 Substitute environment variables referred to in FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 `$FOO' where FOO is an environment variable name means to substitute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 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
1386 with a character, not a letter, digit or underscore; otherwise, enclose
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 the entire variable name in braces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 If `/~' appears, all of FILENAME through that `/' is discarded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1390 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1392 /* This function can GC. GC checked 2000-07-28 ben. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1393 Intbyte *nm;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1394
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1395 Intbyte *s, *p, *o, *x, *endp;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1396 Intbyte *target = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 int total = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 int substituted = 0;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1399 Intbyte *xnm;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1402 CHECK_STRING (filename);
428
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 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1406 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 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
1409 filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1410
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1411 nm = XSTRING_DATA (filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1412 endp = nm + XSTRING_LENGTH (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 /* If /~ or // appears, discard everything through first slash. */
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 for (p = nm; p != endp; p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 if ((p[0] == '~'
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1419 #if defined (WIN32_FILENAMES)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
1420 /* // at start of file name is meaningful in WindowsNT systems */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 || (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
1422 #else /* not (WIN32_FILENAMES) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 || IS_DIRECTORY_SEP (p[0])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1424 #endif /* not (WIN32_FILENAMES) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 && p != nm
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 && (IS_DIRECTORY_SEP (p[-1])))
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 nm = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 substituted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1432 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 /* see comment in expand-file-name about drive specifiers */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 else if (IS_DRIVE (p[0]) && p[1] == ':'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 && p > nm && IS_DIRECTORY_SEP (p[-1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 nm = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 substituted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1440 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 /* See if any variables are substituted into the string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 and find the total length of their values in `total' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 for (p = nm; p != endp;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 if (*p != '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 if (p == endp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 goto badsubst;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 else if (*p == '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 /* "$$" means a single "$" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 total -= 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 substituted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 else if (*p == '{')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 o = ++p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 while (p != endp && *p != '}') p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 if (*p != '}') goto missingclose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 s = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 o = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 while (p != endp && (isalnum (*p) || *p == '_')) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 s = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 /* Copy out the variable name */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1477 target = (Intbyte *) alloca (s - o + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 strncpy ((char *) target, (char *) o, s - o);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 target[s - o] = 0;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1480 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 strupr (target); /* $home == $HOME etc. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1482 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 /* Get variable value */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1485 o = (Intbyte *) egetenv ((char *) target);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 if (!o) goto badvar;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 total += strlen ((char *) o);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 substituted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 }
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 (!substituted)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1492 return filename;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1493
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1494 /* If substitution required, recopy the filename and do it */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 /* Make space in stack frame for the new copy */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1496 xnm = (Intbyte *) alloca (XSTRING_LENGTH (filename) + total + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 x = xnm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 /* Copy the rest of the name through, replacing $ constructs with values */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 for (p = nm; *p;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 if (*p != '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 *x++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 if (p == endp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 goto badsubst;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 else if (*p == '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 *x++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 else if (*p == '{')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 o = ++p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 while (p != endp && *p != '}') p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 if (*p != '}') goto missingclose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 s = p++;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 o = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 while (p != endp && (isalnum (*p) || *p == '_')) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 s = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 /* Copy out the variable name */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1528 target = (Intbyte *) alloca (s - o + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 strncpy ((char *) target, (char *) o, s - o);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 target[s - o] = 0;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1531 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 strupr (target); /* $home == $HOME etc. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1533 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 /* Get variable value */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1536 o = (Intbyte *) egetenv ((char *) target);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 if (!o)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 goto badvar;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 strcpy ((char *) x, (char *) o);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 x += strlen ((char *) o);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 *x = 0;
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 /* If /~ or // appears, discard everything through first slash. */
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 for (p = xnm; p != x; p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 if ((p[0] == '~'
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1550 #if defined (WIN32_FILENAMES)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 || (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
1552 #else /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 || IS_DIRECTORY_SEP (p[0])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1554 #endif /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 /* 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
1557 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 xnm = p;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1559 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 else if (IS_DRIVE (p[0]) && p[1] == ':'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 && p > nm && IS_DIRECTORY_SEP (p[-1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 xnm = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 return make_string (xnm, x - xnm);
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 badsubst:
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1568 syntax_error ("Bad format environment-variable substitution", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 missingclose:
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1570 syntax_error ("Missing \"}\" in environment-variable substitution",
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1571 filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 badvar:
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1573 syntax_error_2 ("Substituting nonexistent environment variable",
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1574 filename, build_string ((char *) target));
428
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 /* NOTREACHED */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 return Qnil; /* suppress compiler warning */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 /* A slightly faster and more convenient way to get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 (directory-file-name (expand-file-name FOO)). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1586 /* This function can call Lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 struct gcpro gcpro1;
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 abspath = Fexpand_file_name (filename, defdir);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 /* Remove final slash, if any (unless path is root).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 stat behaves differently depending! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 if (XSTRING_LENGTH (abspath) > 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 && IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 && !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 /* We cannot take shortcuts; they might be wrong for magic file names. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 abspath = Fdirectory_file_name (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 return abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 }
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 /* Signal an error if the file ABSNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 If INTERACTIVE is nonzero, ask the user whether to proceed,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 and bypass the error if the user says to go ahead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 QUERYSTRING is a name for the action that is being considered
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 to alter the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 *STATPTR is used to store the stat information if the file exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 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
1610
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 static void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1612 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
1613 int interactive, struct stat *statptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1615 /* This function can call Lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 struct stat statbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 /* stat is a good way to tell whether the file exists,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 regardless of what access permissions it has. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1620 if (xemacs_stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 if (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 Lisp_Object prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 prompt = emacs_doprnt_string_c
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1630 ((const Intbyte *) GETTEXT ("File %s already exists; %s anyway? "),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 Qnil, -1, XSTRING_DATA (absname),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 GETTEXT (querystring));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 GCPRO1 (prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 tem = call1 (Qyes_or_no_p, prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 tem = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 if (NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 Fsignal (Qfile_already_exists,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 list2 (build_translated_string ("File already exists"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 absname));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 if (statptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 *statptr = statbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 if (statptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 statptr->st_mode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 return;
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 DEFUN ("copy-file", Fcopy_file, 2, 4,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 "fCopy file: \nFCopy %s to file: \np\nP", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1658 Copy FILENAME to NEWNAME. Both args must be strings.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 Signals a `file-already-exists' error if file NEWNAME already exists,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 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
1661 A number as third arg means request confirmation if NEWNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 This is what happens in interactive use with M-x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 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
1664 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
1665 A prefix arg makes KEEP-TIME non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 (filename, newname, ok_if_already_exists, keep_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1669 /* This function can call Lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 int ifd, ofd, n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 char buf[16 * 1024];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 struct stat st, out_st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 /* Lisp_Object args[6]; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 int input_file_statable_p;
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 GCPRO2 (filename, newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 CHECK_STRING (newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 newname = Fexpand_file_name (newname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 /* If the input file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 handler = Ffind_file_name_handler (filename, Qcopy_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 /* Likewise for output file name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 handler = Ffind_file_name_handler (newname, Qcopy_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 return call5 (handler, Qcopy_file, filename, newname,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 ok_if_already_exists, keep_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 }
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 /* When second argument is a directory, copy the file into it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 if (!NILP (Ffile_directory_p (newname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 Lisp_Object args[3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 int i = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 args[0] = newname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 args[1] = Qnil; args[2] = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 NGCPRO1 (*args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 ngcpro1.nvars = 3;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1711 if (!IS_DIRECTORY_SEP (XSTRING_BYTE (newname,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1712 XSTRING_LENGTH (newname) - 1)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1713
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1714 args[i++] = Fchar_to_string (Vdirectory_sep_char);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 args[i++] = Ffile_name_nondirectory (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 newname = Fconcat (i, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722 barf_or_query_if_file_exists (newname, "copy to it",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 INTP (ok_if_already_exists), &out_st);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1724 else if (xemacs_stat ((const char *) XSTRING_DATA (newname), &out_st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 out_st.st_mode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 if (ifd < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1729 report_file_error ("Opening input file", filename);
428
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 record_unwind_protect (close_file_unwind, make_int (ifd));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 /* 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
1734 copyable by us. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 input_file_statable_p = (fstat (ifd, &st) >= 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1737 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 if (out_st.st_mode != 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 && 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
1740 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 errno = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 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
1743 list3 (Qunbound, filename, newname));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 #if defined (S_ISREG) && defined (S_ISLNK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 if (input_file_statable_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 if (!(S_ISREG (st.st_mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 #ifdef S_ISCHR
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 && !(S_ISCHR (st.st_mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 && !(S_ISLNK (st.st_mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 #if defined (EISDIR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 /* Get a better looking error message. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 errno = EISDIR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 #endif /* EISDIR */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1761 report_file_error ("Non-regular file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 #endif /* S_ISREG && S_ISLNK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 ofd = open( (char *) XSTRING_DATA (newname),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 if (ofd < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1769 report_file_error ("Opening output file", newname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
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 record_unwind_protect (close_file_unwind, ofd_locative);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 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
1779 report_file_error ("I/O error", newname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 /* Closing the output clobbers the file times on some systems. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 if (close (ofd) < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1784 report_file_error ("I/O error", newname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 if (input_file_statable_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1788 if (!NILP (keep_time))
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 EMACS_TIME atime, mtime;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1791 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1792 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
1793 if (set_file_times (newname, atime, mtime))
4f6ba8f1fb3d [xemacs-hg @ 2001-05-31 12:03:37 by adrian]
adrian
parents: 563
diff changeset
1794 report_file_error ("I/O error", list1 (newname));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1795 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1796 chmod ((const char *) XSTRING_DATA (newname),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1797 st.st_mode & 07777);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 /* We'll close it by hand */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 XCAR (ofd_locative) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 /* Close ifd */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 unbind_to (speccount, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 Create a directory. One argument, a file name string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 (dirname_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 char dir [MAXPATHLEN];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 CHECK_STRING (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 dirname_ = Fexpand_file_name (dirname_, Qnil);
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 GCPRO1 (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 return (call2 (handler, Qmake_directory_internal, dirname_));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 return Fsignal (Qfile_error,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 list3 (build_translated_string ("Creating directory"),
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1834 build_translated_string ("pathname too long"),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 dirname_));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 strncpy (dir, (char *) XSTRING_DATA (dirname_),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 XSTRING_LENGTH (dirname_) + 1);
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 if (dir [XSTRING_LENGTH (dirname_) - 1] == '/')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 dir [XSTRING_LENGTH (dirname_) - 1] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 if (mkdir (dir, 0777) != 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1844 report_file_error ("Creating directory", dirname_);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 return Qnil;
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 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 Delete a directory. One argument, a file name or directory name string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 (dirname_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 struct gcpro gcpro1;
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 CHECK_STRING (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 GCPRO1 (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 dirname_ = Fexpand_file_name (dirname_, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 dirname_ = Fdirectory_file_name (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 return (call2 (handler, Qdelete_directory, dirname_));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 if (rmdir ((char *) XSTRING_DATA (dirname_)) != 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1870 report_file_error ("Removing directory", dirname_);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 }
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 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1876 Delete the file named FILENAME (a string).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1877 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
1878 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 GCPRO1 (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 handler = Ffind_file_name_handler (filename, Qdelete_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 return call2 (handler, Qdelete_file, filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 if (0 > unlink ((char *) XSTRING_DATA (filename)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1895 report_file_error ("Removing old name", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 internal_delete_file_1 (Lisp_Object ignore, Lisp_Object ignore2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 internal_delete_file (Lisp_Object filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 internal_delete_file_1, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 }
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 DEFUN ("rename-file", Frename_file, 2, 3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 "fRename file: \nFRename %s to file: \np", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1917 Rename FILENAME as NEWNAME. Both args must be strings.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1918 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
1919 Signals a `file-already-exists' error if a file NEWNAME already exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 A number as third arg means request confirmation if NEWNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 This is what happens in interactive use with M-x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 (filename, newname, ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 GCPRO2 (filename, newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 CHECK_STRING (newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 newname = Fexpand_file_name (newname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 handler = Ffind_file_name_handler (filename, Qrename_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 handler = Ffind_file_name_handler (newname, Qrename_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 return call4 (handler, Qrename_file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 filename, newname, ok_if_already_exists);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 }
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 /* When second argument is a directory, rename the file into it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 if (!NILP (Ffile_directory_p (newname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 Lisp_Object args[3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 int i = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 args[0] = newname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 args[1] = Qnil; args[2] = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 NGCPRO1 (*args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 ngcpro1.nvars = 3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 args[i++] = build_string ("/");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 args[i++] = Ffile_name_nondirectory (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 newname = Fconcat (i, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 barf_or_query_if_file_exists (newname, "rename to it",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 INTP (ok_if_already_exists), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1974 WIN32_NATIVE here; I've removed it. --marcpa */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1975
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1976 /* We have configure check for rename() and emulate using
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1977 link()/unlink() if necessary. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 if (0 > rename ((char *) XSTRING_DATA (filename),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 (char *) XSTRING_DATA (newname)))
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 if (errno == EXDEV)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 Fcopy_file (filename, newname,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 /* We have already prompted if it was an integer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 so don't have copy-file prompt again. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 (NILP (ok_if_already_exists) ? Qnil : Qt),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 Fdelete_file (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1992 report_file_error ("Renaming", list3 (Qunbound, filename, newname));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 "fAdd name to file: \nFName to add to %s: \np", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2001 Give FILENAME additional name NEWNAME. Both args must be strings.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 Signals a `file-already-exists' error if a file NEWNAME already exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 A number as third arg means request confirmation if NEWNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 This is what happens in interactive use with M-x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 (filename, newname, ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 GCPRO2 (filename, newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 CHECK_STRING (newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 newname = Fexpand_file_name (newname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 newname, ok_if_already_exists));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 /* If the new name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 newname, ok_if_already_exists));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 barf_or_query_if_file_exists (newname, "make it a new name",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 INTP (ok_if_already_exists), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 on NT here. --marcpa */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 Reverted to previous behavior pending a working fix. (jhar) */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2042 #if defined(WIN32_NATIVE)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 /* Windows does not support this operation. */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2044 signal_error_2 (Qunimplemented, "Adding new name", filename, newname);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2045 #else /* not defined(WIN32_NATIVE) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 unlink ((char *) XSTRING_DATA (newname));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 if (0 > link ((char *) XSTRING_DATA (filename),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 (char *) XSTRING_DATA (newname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 report_file_error ("Adding new name",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2052 list3 (Qunbound, filename, newname));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2054 #endif /* defined(WIN32_NATIVE) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 Signals a `file-already-exists' error if a file LINKNAME already exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 A number as third arg means request confirmation if LINKNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 This happens for interactive use with M-x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 (filename, linkname, ok_if_already_exists))
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 /* This function can GC. GC checked 1997.06.04. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2071 /* 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
2072 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 GCPRO2 (filename, linkname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 CHECK_STRING (linkname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 /* If the link target has a ~, we must expand it to get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 a truly valid file name. Otherwise, do not expand;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 we want to permit links to relative file names. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 if (XSTRING_BYTE (filename, 0) == '~')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 linkname = Fexpand_file_name (linkname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 ok_if_already_exists));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 /* If the new link name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 linkname, ok_if_already_exists));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2099 #ifdef S_IFLNK
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 barf_or_query_if_file_exists (linkname, "make it a link",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 INTP (ok_if_already_exists), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 unlink ((char *) XSTRING_DATA (linkname));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 if (0 > symlink ((char *) XSTRING_DATA (filename),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 (char *) XSTRING_DATA (linkname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 report_file_error ("Making symbolic link",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2110 list3 (Qunbound, filename, linkname));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2112 #endif /* S_IFLNK */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2113
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 #ifdef HPUX_NET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 Open a network connection to PATH using LOGIN as the login string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 (path, login))
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 int netresult;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2126 const char *path_ext;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2127 const char *login_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 CHECK_STRING (path);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 CHECK_STRING (login);
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 /* netunam, being a strange-o system call only used once, is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 encapsulated. */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2134
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2135 LISP_STRING_TO_EXTERNAL (path, path_ext, Qfile_name);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2136 LISP_STRING_TO_EXTERNAL (login, login_ext, Qnative);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2137
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2138 netresult = netunam (path_ext, login_ext);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2139
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2140 return netresult == -1 ? Qnil : Qt;
428
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 #endif /* HPUX_NET */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 Return t if file FILENAME specifies an absolute path name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 On Unix, this is a name starting with a `/' or a `~'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 /* This function does not GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2151 Intbyte *ptr;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 ptr = XSTRING_DATA (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
2156 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 ) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 /* Return nonzero if file FILENAME exists and can be executed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 check_executable (char *filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2167 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168 struct stat st;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2169 if (xemacs_stat (filename, &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 return ((st.st_mode & S_IEXEC) != 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2172 #else /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 #ifdef HAVE_EACCESS
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2174 return eaccess (filename, X_OK) >= 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 /* Access isn't quite right because it uses the real uid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 and we really want to test with the effective uid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 But Unix doesn't give us a right way to do it. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2179 return access (filename, X_OK) >= 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 #endif /* HAVE_EACCESS */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2181 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184 /* Return nonzero if file FILENAME exists and can be written. */
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 static int
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2187 check_writable (const char *filename)
428
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 #ifdef HAVE_EACCESS
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2190 return (eaccess (filename, W_OK) >= 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 /* Access isn't quite right because it uses the real uid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 and we really want to test with the effective uid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 But Unix doesn't give us a right way to do it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 Opening with O_WRONLY could work for an ordinary file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 but would lose for directories. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2197 return (access (filename, W_OK) >= 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 }
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-exists-p", Ffile_exists_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 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
2203 See also `file-readable-p' and `file-attributes'.
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 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2207 /* This function can call lisp; GC checked 2000-07-11 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 struct stat statbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 abspath = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 return call2 (handler, Qfile_exists_p, abspath);
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 return xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 Return t if FILENAME can be executed by you.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 For a directory, this means you can access files in that directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2234 /* This function can GC. GC checked 07-11-2000 ben. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 abspath = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 return call2 (handler, Qfile_executable_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 return check_executable ((char *) XSTRING_DATA (abspath)) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254 Return t if file FILENAME exists and you can read it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 See also `file-exists-p' and `file-attributes'.
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 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 Lisp_Object abspath = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 abspath = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
2274 #if defined(WIN32_FILENAMES)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 /* Under MS-DOS and Windows, open does not work for directories. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 UNGCPRO;
593
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 592
diff changeset
2277 if (access ((char *) XSTRING_DATA (abspath), 0) == 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 return Qnil;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
2281 #else /* not WIN32_FILENAMES */
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 int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285 if (desc < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 close (desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
2290 #endif /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294 on the RT/PC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 Return t if file FILENAME can be written or created by you.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 Lisp_Object abspath, dir;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 struct stat statbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 abspath = Fexpand_file_name (filename, Qnil);
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 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 return call2 (handler, Qfile_writable_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2317 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 return (check_writable ((char *) XSTRING_DATA (abspath))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 ? Qt : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320
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 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 dir = Ffile_name_directory (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 : "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 ? Qt : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 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
2332 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
2333 Otherwise returns nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337 /* This function can GC. GC checked 1997.04.10. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2338 /* 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
2339 #ifdef S_IFLNK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 char *buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 int bufsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 int valsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 Lisp_Object val;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2344 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 filename = Fexpand_file_name (filename, Qnil);
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 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 GCPRO1 (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 return call2 (handler, Qfile_symlink_p, filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2359 #ifdef S_IFLNK
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 bufsize = 100;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 buf = xnew_array_and_zero (char, bufsize);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 valsize = readlink ((char *) XSTRING_DATA (filename),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 buf, bufsize);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366 if (valsize < bufsize) break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 /* Buffer was not long enough */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 xfree (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369 bufsize *= 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 if (valsize == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 xfree (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375 }
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2376 val = make_string ((Intbyte *) buf, valsize);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 xfree (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379 #else /* not S_IFLNK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 #endif /* not S_IFLNK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385 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
2386 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
2387 if the directory so specified exists and really is a directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 abspath = expand_and_dir_to_file (filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 return call2 (handler, Qfile_directory_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2410 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416 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
2417 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
2418 directory as a buffer's current directory, this predicate must return true.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2419 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
2420 if the directory so specified exists and really is a readable and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2421 searchable directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426 Lisp_Object handler;
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 the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432 return call2 (handler, Qfile_accessible_directory_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2435 #if !defined(WIN32_NATIVE)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436 if (NILP (Ffile_directory_p (filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 return (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 return Ffile_executable_p (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442 int tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 /* 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
2445 Suppose that file-accessible-directory-p has no handler, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446 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
2447 relocates the string in `filename'; and finally file-directory-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 returns non-nil. Then we would end up passing a garbaged string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449 to file-executable-p. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 GCPRO1 (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451 tem = (NILP (Ffile_directory_p (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 || NILP (Ffile_executable_p (filename)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 return tem ? Qnil : Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2456 #endif /* !defined(WIN32_NATIVE) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 }
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 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 Return t if file FILENAME is the name of a regular file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 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
2462 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 struct gcpro gcpro1;
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 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 return call2 (handler, Qfile_regular_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2483 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2489 Return mode bits of file named FILENAME, as an integer.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 struct gcpro gcpro1;
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 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 abspath = expand_and_dir_to_file (filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507 handler = Ffind_file_name_handler (abspath, Qfile_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 return call2 (handler, Qfile_modes, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2512 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 /* 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
2515 #if 0
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2516 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 if (check_executable (XSTRING_DATA (abspath)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 st.st_mode |= S_IEXEC;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2519 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 #endif /* 0 */
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 return make_int (st.st_mode & 07777);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2526 Set mode bits of file named FILENAME to MODE (an integer).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 Only the 12 low bits of MODE are used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 (filename, mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 abspath = Fexpand_file_name (filename, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2540 CHECK_INT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2545 handler = Ffind_file_name_handler (abspath, Qset_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 return call3 (handler, Qset_file_modes, abspath, mode);
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 if (chmod ((char *) XSTRING_DATA (abspath), XINT (mode)) < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2551 report_file_error ("Doing chmod", abspath);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554 }
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 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557 Set the file permission bits for newly created files.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2558 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
2559 subsequently created files will not have the permission corresponding
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2560 to that bit enabled. Only the low 9 bits are used.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2561 This setting is inherited by subprocesses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2562 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 (mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 CHECK_INT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2567 umask ((~ XINT (mode)) & 0777);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2571
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2572 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2573 Return the default file protection for created files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2574 The umask value determines which permissions are enabled in newly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2575 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
2576 created files will not have that permission enabled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577 */
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580 int mode;
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 mode = umask (0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 umask (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 return make_int ((~ mode) & 0777);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 }
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 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589 Tell Unix to finish all pending disk updates.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2590 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2592 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2593 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2594 sync ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2595 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2596 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2597 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2600 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
2601 Return t if file FILE1 is newer than file FILE2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2602 If FILE1 does not exist, the answer is nil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2603 otherwise, if FILE2 does not exist, the answer is t.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2604 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2605 (file1, file2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2606 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2607 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2608 Lisp_Object abspath1, abspath2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2609 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2610 int mtime1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2611 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2612 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2613
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2614 CHECK_STRING (file1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2615 CHECK_STRING (file2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2616
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2617 abspath1 = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2618 abspath2 = Qnil;
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 GCPRO3 (abspath1, abspath2, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2621 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2622 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
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 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2625 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2626 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2627 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2628 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2629 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2630 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2631 return call3 (handler, Qfile_newer_than_file_p, abspath1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2632 abspath2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2633
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2634 if (xemacs_stat ((char *) XSTRING_DATA (abspath1), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2635 return Qnil;
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 mtime1 = st.st_mtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2638
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2639 if (xemacs_stat ((char *) XSTRING_DATA (abspath2), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2640 return Qt;
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 (mtime1 > st.st_mtime) ? Qt : Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2646 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2647 /* #define READ_BUF_SIZE (2 << 16) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 #define READ_BUF_SIZE (1 << 15)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2650 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651 1, 7, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 Insert contents of file FILENAME after point; no coding-system frobbing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653 This function is identical to `insert-file-contents' except for the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2654 handling of the CODESYS and USED-CODESYS arguments under
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655 XEmacs/Mule. (When Mule support is not present, both functions are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656 identical and ignore the CODESYS and USED-CODESYS arguments.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2657
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658 If support for Mule exists in this Emacs, the file is decoded according
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 it should be a symbol, and the actual coding system that was used for the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661 decoding is stored into it. It will in general be different from CODESYS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2662 if CODESYS specifies automatic encoding detection or end-of-line detection.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2663
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2664 Currently START and END refer to byte positions (as opposed to character
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 positions), even in Mule. (Fixing this is very difficult.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2667 (filename, visit, start, end, replace, codesys, used_codesys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 int fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 int saverrno = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 Charcount inserted = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 int speccount;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676 Lisp_Object handler = Qnil, val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 int total;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2678 Intbyte read_buf[READ_BUF_SIZE];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2679 int mc_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680 struct buffer *buf = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 Lisp_Object curbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 int not_regular = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 if (buf->base_buffer && ! NILP (visit))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2685 invalid_operation ("Cannot do file visiting in an indirect buffer", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2687 /* No need to call Fbarf_if_buffer_read_only() here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2688 That's called in begin_multiple_change() or wherever. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2689
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2690 val = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2691
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 /* #### dmoore - should probably check in various places to see if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693 curbuf was killed and if so signal an error? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695 XSETBUFFER (curbuf, buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2696
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697 GCPRO5 (filename, val, visit, handler, curbuf);
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 mc_count = (NILP (replace)) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2700 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf));
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 speccount = specpdl_depth (); /* begin_multiple_change also adds
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704 an unwind_protect */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2711 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2712 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2713 val = call6 (handler, Qinsert_file_contents, filename,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2714 visit, start, end, replace);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2715 goto handled;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2716 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2717
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718 #ifdef FILE_CODING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2719 if (!NILP (used_codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2720 CHECK_SYMBOL (used_codesys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2721 #endif
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 if ( (!NILP (start) || !NILP (end)) && !NILP (visit) )
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2724 invalid_operation ("Attempt to visit less than an entire file", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2725
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2726 fd = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2727
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2728 if (xemacs_stat ((char *) XSTRING_DATA (filename), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2729 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730 if (fd >= 0) close (fd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731 badopen:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 if (NILP (visit))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2733 report_file_error ("Opening input file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2734 st.st_mtime = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 goto notfound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2737
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2738 #ifdef S_IFREG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2739 /* 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
2740 REPLACE, START or END being non-nil. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741 if (!S_ISREG (st.st_mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2742 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2743 not_regular = 1;
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 if (!NILP (visit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2746 goto notfound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2747
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2748 if (!NILP (replace) || !NILP (start) || !NILP (end))
428
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 end_multiple_change (buf, mc_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2752 RETURN_UNGCPRO
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2753 (Fsignal (Qfile_error,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2754 list2 (build_translated_string("not a regular file"),
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2755 filename)));
428
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2758 #endif /* S_IFREG */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2759
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2760 if (!NILP (start))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2761 CHECK_INT (start);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2762 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2763 start = Qzero;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2765 if (!NILP (end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 CHECK_INT (end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2767
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2768 if (fd < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2769 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2770 if ((fd = interruptible_open ((char *) XSTRING_DATA (filename),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2771 O_RDONLY | OPEN_BINARY, 0)) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2772 goto badopen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773 }
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 /* Replacement should preserve point as it preserves markers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 if (!NILP (replace))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2778
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2779 record_unwind_protect (close_file_unwind, make_int (fd));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2780
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2781 /* Supposedly happens on VMS. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782 if (st.st_size < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2783 signal_error (Qfile_error, "File size is negative", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2785 if (NILP (end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2786 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787 if (!not_regular)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2788 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2789 end = make_int (st.st_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790 if (XINT (end) != st.st_size)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2791 out_of_memory ("Maximum buffer size exceeded", Qunbound);
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795 /* If requested, replace the accessible part of the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796 with the file contents. Avoid replacing text at the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 beginning or end of the buffer that matches the file contents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 that preserves markers pointing to the unchanged parts. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799 #if !defined (FILE_CODING)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800 /* The replace-mode code currently only works when the assumption
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 'one byte == one char' holds true. This fails Mule because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2802 files may contain multibyte characters. It holds under Windows NT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2803 provided we convert CRLF into LF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2804 # define FSFMACS_SPEEDY_INSERT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 #endif /* !defined (FILE_CODING) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2806
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2807 #ifndef FSFMACS_SPEEDY_INSERT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808 if (!NILP (replace))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2809 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2810 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
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 #else /* FSFMACS_SPEEDY_INSERT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814 if (!NILP (replace))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2815 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2816 char buffer[1 << 14];
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2817 Charbpos same_at_start = BUF_BEGV (buf);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2818 Charbpos same_at_end = BUF_ZV (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819 int overlap;
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 /* Count how many chars at the start of the file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 match the text at the beginning of the buffer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825 int nread;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2826 Charbpos charbpos;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 613
diff changeset
2827 nread = read_allowing_quit (fd, buffer, sizeof (buffer));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828 if (nread < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2829 report_file_error ("Reading", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830 else if (nread == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2831 break;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2832 charbpos = 0;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2833 while (charbpos < nread && same_at_start < BUF_ZV (buf)
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2834 && BUF_FETCH_CHAR (buf, same_at_start) == buffer[charbpos])
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2835 same_at_start++, charbpos++;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836 /* If we found a discrepancy, stop the scan.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 Otherwise loop around and scan the next bufferful. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2838 if (charbpos != nread)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839 break;
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 the file matches the buffer completely,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842 there's no need to replace anything. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843 if (same_at_start - BUF_BEGV (buf) == st.st_size)
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 close (fd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2846 unbind_to (speccount, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2847 /* Truncate the buffer to the size of the file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2848 buffer_delete_range (buf, same_at_start, same_at_end,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2849 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2850 goto handled;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2851 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2852 /* Count how many chars at the end of the file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2853 match the text at the end of the buffer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2855 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856 int total_read, nread;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2857 Charbpos charbpos, curpos, trial;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859 /* At what file position are we now scanning? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2860 curpos = st.st_size - (BUF_ZV (buf) - same_at_end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861 /* If the entire file matches the buffer tail, stop the scan. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2862 if (curpos == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2863 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 /* How much can we scan in the next step? */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2865 trial = min (curpos, (Charbpos) sizeof (buffer));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2866 if (lseek (fd, curpos - trial, 0) < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2867 report_file_error ("Setting file position", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2868
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2869 total_read = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2870 while (total_read < trial)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2871 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2872 nread = read_allowing_quit (fd, buffer + total_read,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2873 trial - total_read);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2874 if (nread <= 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2875 report_file_error ("IO error reading file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2876 total_read += nread;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2877 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2878 /* Scan this bufferful from the end, comparing with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2879 the Emacs buffer. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2880 charbpos = total_read;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2881 /* Compare with same_at_start to avoid counting some buffer text
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2882 as matching both at the file's beginning and at the end. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2883 while (charbpos > 0 && same_at_end > same_at_start
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2884 && BUF_FETCH_CHAR (buf, same_at_end - 1) ==
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2885 buffer[charbpos - 1])
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2886 same_at_end--, charbpos--;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2887 /* If we found a discrepancy, stop the scan.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2888 Otherwise loop around and scan the preceding bufferful. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2889 if (charbpos != 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2890 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2891 /* If display current starts at beginning of line,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2892 keep it that way. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2893 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2894 XWINDOW (Fselected_window (Qnil))->start_at_line_beg =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2895 !NILP (Fbolp (make_buffer (buf)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2896 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2897
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2898 /* Don't try to reuse the same piece of text twice. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2899 overlap = same_at_start - BUF_BEGV (buf) -
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2900 (same_at_end + st.st_size - BUF_ZV (buf));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2901 if (overlap > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2902 same_at_end += overlap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2903
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2904 /* Arrange to read only the nonmatching middle part of the file. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2905 start = make_int (same_at_start - BUF_BEGV (buf));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2906 end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2907
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2908 buffer_delete_range (buf, same_at_start, same_at_end,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2909 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2910 /* Insert from the file at the proper position. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2911 BUF_SET_PT (buf, same_at_start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2912 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2913 #endif /* FSFMACS_SPEEDY_INSERT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2914
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2915 if (!not_regular)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2916 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2917 total = XINT (end) - XINT (start);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2919 /* Make sure point-max won't overflow after this insertion. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2920 if (total != XINT (make_int (total)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2921 out_of_memory ("Maximum buffer size exceeded", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 /* 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
2925 will make the stream functions read as much as possible. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2926 total = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2927
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2928 if (XINT (start) != 0
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2929 #ifdef FSFMACS_SPEEDY_INSERT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2930 /* 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
2931 connivings above will normally put the file pointer other than
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2932 where it should be. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2933 || !NILP (replace)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2934 #endif /* !FSFMACS_SPEEDY_INSERT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2935 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2936 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2937 if (lseek (fd, XINT (start), 0) < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2938 report_file_error ("Setting file position", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2939 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2941 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2942 Charbpos cur_point = BUF_PT (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2943 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2944 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2945 LSTR_ALLOW_QUIT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2946
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2947 NGCPRO1 (stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2948 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2949 #ifdef FILE_CODING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2950 stream = make_decoding_input_stream
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2951 (XLSTREAM (stream), Fget_coding_system (codesys));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2952 Lstream_set_character_mode (XLSTREAM (stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2953 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2954 #endif /* FILE_CODING */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2955
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2956 record_unwind_protect (delete_stream_unwind, stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2957
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2958 /* 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
2959 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2960 occurs inside of the filedesc stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2961 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2962 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2963 Bytecount this_len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2964 Charcount cc_inserted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2965
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2966 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2967 this_len = Lstream_read (XLSTREAM (stream), read_buf,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2968 sizeof (read_buf));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2969
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2970 if (this_len <= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2971 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2972 if (this_len < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2973 saverrno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2974 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2976
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2977 cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2978 this_len,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979 !NILP (visit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2980 ? INSDEL_NO_LOCKING : 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2981 inserted += cc_inserted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2982 cur_point += cc_inserted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2983 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2984 #ifdef FILE_CODING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2985 if (!NILP (used_codesys))
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 Fset (used_codesys,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2988 XCODING_SYSTEM_NAME (decoding_stream_coding_system (XLSTREAM (stream))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 #endif /* FILE_CODING */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991 NUNGCPRO;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994 /* Close the file/stream */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2995 unbind_to (speccount, Qnil);
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 if (saverrno != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2999 errno = saverrno;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3000 report_file_error ("Reading", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3001 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3003 notfound:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004 handled:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3005
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3006 end_multiple_change (buf, mc_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3007
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3008 if (!NILP (visit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3009 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010 if (!EQ (buf->undo_list, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011 buf->undo_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014 buf->modtime = st.st_mtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015 buf->filename = filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016 /* XEmacs addition: */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 /* This function used to be in C, ostensibly so that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3018 it could be called here. But that's just silly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3019 There's no reason C code can't call out to Lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3020 code, and it's a lot cleaner this way. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3021 /* Note: compute-buffer-file-truename is called for
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3022 side-effect! Its return value is intentionally
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3023 ignored. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024 if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025 call1 (Qcompute_buffer_file_truename, make_buffer (buf));
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 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 buf->auto_save_modified = BUF_MODIFF (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 buf->saved_size = make_int (BUF_SIZE (buf));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3031 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3032 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033 if (!NILP (buf->file_truename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034 unlock_file (buf->file_truename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3035 unlock_file (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3036 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3037 #endif /* CLASH_DETECTION */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038 if (not_regular)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3039 RETURN_UNGCPRO (Fsignal (Qfile_error,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3040 list2 (build_string ("not a regular file"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3041 filename)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3042
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3043 /* If visiting nonexistent file, return nil. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3044 if (buf->modtime == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3045 report_file_error ("Opening input file",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3046 filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049 /* Decode file format */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050 if (inserted > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3051 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3052 Lisp_Object insval = call3 (Qformat_decode,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053 Qnil, make_int (inserted), visit);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3054 CHECK_INT (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3055 inserted = XINT (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3056 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3058 if (inserted > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3059 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060 Lisp_Object p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3062
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3063 NGCPRO1 (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064 EXTERNAL_LIST_LOOP (p, Vafter_insert_file_functions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066 Lisp_Object insval =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3067 call1 (XCAR (p), make_int (inserted));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3068 if (!NILP (insval))
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 CHECK_NATNUM (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3071 inserted = XINT (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3073 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3074 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3075 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3076 }
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 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3079
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080 if (!NILP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3081 return (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 return (list2 (filename, make_int (inserted)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3084 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3088 Lisp_Object *annot);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3089 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3090
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091 /* If build_annotations switched buffers, switch back to BUF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3092 Kill the temporary buffer that was selected in the meantime. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3093
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3094 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3095 build_annotations_unwind (Lisp_Object buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097 Lisp_Object tembuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3099 if (XBUFFER (buf) == current_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3101 tembuf = Fcurrent_buffer ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102 Fset_buffer (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3103 Fkill_buffer (tembuf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3104 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3105 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3107 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3108 "r\nFWrite region to file: ", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3109 Write current region into specified file; no coding-system frobbing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3110 This function is identical to `write-region' except for the handling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3111 of the CODESYS argument under XEmacs/Mule. (When Mule support is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3112 present, both functions are identical and ignore the CODESYS argument.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3113 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
3114 to the value of CODESYS. If this is nil, no code conversion occurs.
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 (start, end, filename, append, visit, lockname, codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3117 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3118 /* This function can call lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3119 int desc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3120 int failure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3121 int save_errno = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3122 struct stat st;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3123 Lisp_Object fn = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3124 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3125 int visiting_other = STRINGP (visit);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3126 int visiting = (EQ (visit, Qt) || visiting_other);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3127 int quietly = (!visiting && !NILP (visit));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3128 Lisp_Object visit_file = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3129 Lisp_Object annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3130 struct buffer *given_buffer;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
3131 Charbpos start1, end1;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3132 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3133 struct gcpro ngcpro1, ngcpro2;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3134 Lisp_Object curbuf;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3135
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3136 XSETBUFFER (curbuf, current_buffer);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3137
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3138 /* start, end, visit, and append are never modified in this fun
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3139 so we don't protect them. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3140 GCPRO5 (visit_file, filename, codesys, lockname, annotations);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3141 NGCPRO2 (curbuf, fn);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3142
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3143 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3144 we should signal an error rather than blissfully continuing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3145 along. ARGH, this function is going to lose lose lose. We need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3146 to protect the current_buffer from being destroyed, but the
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3147 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
3148 protect curbuf now. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3149
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3150 #ifdef FILE_CODING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3151 codesys = Fget_coding_system (codesys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3152 #endif /* FILE_CODING */
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 if (current_buffer->base_buffer && ! NILP (visit))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3155 invalid_operation ("Cannot do file visiting in an indirect buffer",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3156 curbuf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3158 if (!NILP (start) && !STRINGP (start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3159 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3160
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 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 if (visiting_other)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165 visit_file = Fexpand_file_name (visit, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167 visit_file = filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3168 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3170 if (NILP (lockname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171 lockname = visit_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3173 /* 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
3174 more Lisp calling. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 handler = Ffind_file_name_handler (filename, Qwrite_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178 /* If FILENAME has no handler, see if VISIT has one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179 if (NILP (handler) && STRINGP (visit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180 handler = Ffind_file_name_handler (visit, Qwrite_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3181
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3182 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3183 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3184 Lisp_Object val = call8 (handler, Qwrite_region, start, end,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3185 filename, append, visit, lockname, codesys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3186 if (visiting)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3187 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3190 current_buffer->filename = visit_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3191 MARK_MODELINE_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3193 NUNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3194 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3196 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200 if (!auto_saving)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3201 lock_file (lockname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3202 #endif /* CLASH_DETECTION */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3204 /* Special kludge to simplify auto-saving. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3205 if (NILP (start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3206 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3207 start1 = BUF_BEG (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208 end1 = BUF_Z (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3209 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3213 given_buffer = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3214 annotations = build_annotations (start, end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215 if (current_buffer != given_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 start1 = BUF_BEGV (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 end1 = BUF_ZV (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3219 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3220
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3221 fn = filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3222 desc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223 if (!NILP (append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3224 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3225 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 if (desc < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229 desc = open ((char *) XSTRING_DATA (fn),
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3230 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3231 auto_saving ? auto_save_mode_bits : CREAT_MODE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232 }
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 (desc < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3235 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237 save_errno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 if (!auto_saving) unlock_file (lockname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3239 errno = save_errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 #endif /* CLASH_DETECTION */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3241 report_file_error ("Opening output file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3242 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3244 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246 Lisp_Object instream = Qnil, outstream = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3247 struct gcpro nngcpro1, nngcpro2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 /* need to gcpro; QUIT could happen out of call to write() */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3249 NNGCPRO2 (instream, outstream);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251 record_unwind_protect (close_file_unwind, desc_locative);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253 if (!NILP (append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3254 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3255 if (lseek (desc, 0, 2) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3256 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3257 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3258 if (!auto_saving) unlock_file (lockname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3259 #endif /* CLASH_DETECTION */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 report_file_error ("Lseek error",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3261 filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3262 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3263 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3264
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3265 failure = 0;
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 /* Note: I tried increasing the buffering size, along with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3268 various other tricks, but nothing seemed to make much of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3269 a difference in the time it took to save a large file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3270 (Actually that's not true. With a local disk, changing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3271 the buffer size doesn't seem to make much difference.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3272 With an NFS-mounted disk, it could make a lot of difference
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3273 because you're affecting the number of network requests
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3274 that need to be made, and there could be a large latency
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275 for each request. So I've increased the buffer size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3276 to 64K.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3277 outstream = make_filedesc_output_stream (desc, 0, -1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3278 Lstream_set_buffering (XLSTREAM (outstream),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3279 LSTREAM_BLOCKN_BUFFERED, 65536);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3280 #ifdef FILE_CODING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3281 outstream =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3282 make_encoding_output_stream (XLSTREAM (outstream), codesys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3283 Lstream_set_buffering (XLSTREAM (outstream),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3284 LSTREAM_BLOCKN_BUFFERED, 65536);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3285 #endif /* FILE_CODING */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3286 if (STRINGP (start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3287 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3288 instream = make_lisp_string_input_stream (start, 0, -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3289 start1 = 0;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3292 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3293 LSTR_SELECTIVE |
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3294 LSTR_IGNORE_ACCESSIBLE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3295 failure = (0 > (a_write (outstream, instream, start1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3296 &annotations)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3297 save_errno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3298 /* Note that this doesn't close the desc since we created the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3299 stream without the LSTR_CLOSING flag, but it does
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3300 flush out any buffered data. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3301 if (Lstream_close (XLSTREAM (outstream)) < 0)
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 failure = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3304 save_errno = errno;
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 Lstream_close (XLSTREAM (instream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3308 #ifdef HAVE_FSYNC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3309 /* 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
3310 Disk full in NFS may be reported here. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3311 /* 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
3312 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
3313 if (!auto_saving && fsync (desc) < 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3314 /* If fsync fails with EINTR, don't treat that as serious. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3315 && errno != EINTR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3316 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3317 failure = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3318 save_errno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3319 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3320 #endif /* HAVE_FSYNC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3321
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
3322 /* 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
3323 systems where close() can change the modtime. This is known to
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
3324 happen on various NFS file systems, on Windows, and on Linux.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
3325 Rather than handling this on a per-system basis, we
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3326 unconditionally do the xemacs_stat() after the close(). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3327
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3328 /* NFS can report a write failure now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3329 if (close (desc) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3330 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3331 failure = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3332 save_errno = errno;
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 /* Discard the close unwind-protect. Execute the one for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3336 build_annotations (switches back to the original current buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3337 as necessary). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3338 XCAR (desc_locative) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3339 unbind_to (speccount, Qnil);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3340
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3341 NNUNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3342 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3343
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3344 xemacs_stat ((char *) XSTRING_DATA (fn), &st);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3346 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3347 if (!auto_saving)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3348 unlock_file (lockname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3349 #endif /* CLASH_DETECTION */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3350
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3351 /* Do this before reporting IO error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3352 to avoid a "file has changed on disk" warning on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3353 next attempt to save. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3354 if (visiting)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3355 current_buffer->modtime = st.st_mtime;
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 if (failure)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3358 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3359 errno = save_errno;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3360 report_file_error ("Writing file", fn);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3361 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3363 if (visiting)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3364 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3365 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3366 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3367 current_buffer->filename = visit_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3368 MARK_MODELINE_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3369 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3370 else if (quietly)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3371 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3372 NUNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3373 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3374 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3375 }
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 if (!auto_saving)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3378 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3379 if (visiting_other)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3380 message ("Wrote %s", XSTRING_DATA (visit_file));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3381 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3382 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3383 Lisp_Object fsp = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3384 struct gcpro nngcpro1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3385
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3386 NNGCPRO1 (fsp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3387 fsp = Ffile_symlink_p (fn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3388 if (NILP (fsp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3389 message ("Wrote %s", XSTRING_DATA (fn));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3390 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3391 message ("Wrote %s (symlink to %s)",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3392 XSTRING_DATA (fn), XSTRING_DATA (fsp));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3393 NNUNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3394 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3395 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3396 NUNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3397 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3398 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3401 /* #### 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
3402 something so stupid as a subr, just sort the fucking list more
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3403 intelligently. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3404 DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3405 Return t if (car A) is numerically less than (car B).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3406 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3407 (a, b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3408 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3409 Lisp_Object objs[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3410 objs[0] = Fcar (a);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3411 objs[1] = Fcar (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3412 return Flss (2, objs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3413 }
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 /* 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
3416 wrote the above comment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3417 DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3418 Return t if (cdr A) is numerically less than (cdr B).
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 (a, b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3421 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3422 Lisp_Object objs[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3423 objs[0] = Fcdr (a);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3424 objs[1] = Fcdr (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3425 return Flss (2, objs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3426 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3428 /* Build the complete list of annotations appropriate for writing out
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3429 the text between START and END, by calling all the functions in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3430 write-region-annotate-functions and merging the lists they return.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3431 If one of these functions switches to a different buffer, we assume
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3432 that buffer contains altered text. Therefore, the caller must
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3433 make sure to restore the current buffer in all cases,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3434 as save-excursion would do. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3436 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3437 build_annotations (Lisp_Object start, Lisp_Object end)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3440 Lisp_Object annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3441 Lisp_Object p, res;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3442 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3443 Lisp_Object original_buffer;
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 XSETBUFFER (original_buffer, current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3446
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3447 annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3448 p = Vwrite_region_annotate_functions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3449 GCPRO2 (annotations, p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3450 while (!NILP (p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3451 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3452 struct buffer *given_buffer = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3453 Vwrite_region_annotations_so_far = annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3454 res = call2 (Fcar (p), start, end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3455 /* If the function makes a different buffer current,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3456 assume that means this buffer contains altered text to be output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3457 Reset START and END from the buffer bounds
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3458 and discard all previous annotations because they should have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3459 been dealt with by this function. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3460 if (current_buffer != given_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3461 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3462 start = make_int (BUF_BEGV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3463 end = make_int (BUF_ZV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3464 annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3465 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3466 Flength (res); /* Check basic validity of return value */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3467 annotations = merge (annotations, res, Qcar_less_than_car);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3468 p = Fcdr (p);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3471 /* Now do the same for annotation functions implied by the file-format */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3472 if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3473 p = Vauto_save_file_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3474 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3475 p = current_buffer->file_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3476 while (!NILP (p))
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 struct buffer *given_buffer = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3479 Vwrite_region_annotations_so_far = annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3480 res = call4 (Qformat_annotate_function, Fcar (p), start, end,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3481 original_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3482 if (current_buffer != given_buffer)
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 start = make_int (BUF_BEGV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3485 end = make_int (BUF_ZV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3486 annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3487 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3488 Flength (res);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3489 annotations = merge (annotations, res, Qcar_less_than_car);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3490 p = Fcdr (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3491 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3492 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3493 return annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3494 }
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 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3497 EOF is encountered), assuming they start at position POS in the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3498 of string that STREAM refers to. Intersperse with them the annotations
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3499 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
3500 each at its appropriate position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3501
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3502 Modify *ANNOT by discarding elements as we output them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3503 The return value is negative in case of system call failure. */
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 /* 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
3506 function calls to reasonable level. The Lstream stuff itself will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3507 batch to 64K to reduce the number of system calls. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3508
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3509 #define A_WRITE_BATCH_SIZE 4096
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3510
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3511 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3512 a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3513 Lisp_Object *annot)
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 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3516 int nextpos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3517 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3518 Lstream *instr = XLSTREAM (instream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3519 Lstream *outstr = XLSTREAM (outstream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3520
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3521 while (LISTP (*annot))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3522 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3523 tem = Fcar_safe (Fcar (*annot));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3524 if (INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3525 nextpos = XINT (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3526 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3527 nextpos = INT_MAX;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3528 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3529 /* If there are annotations left and we have Mule, then we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3530 have to do the I/O one emchar at a time so we can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3531 determine when to insert the annotation. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3532 if (!NILP (*annot))
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 Emchar ch;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3535 while (pos != nextpos && (ch = Lstream_get_emchar (instr)) != EOF)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3536 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3537 if (Lstream_put_emchar (outstr, ch) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3538 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3539 pos++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3540 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3541 }
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 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3544 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3545 while (pos != nextpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3546 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3547 /* Otherwise there is no point to that. Just go in batches. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3548 int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3550 chunk = Lstream_read (instr, largebuf, chunk);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3551 if (chunk < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3552 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3553 if (chunk == 0) /* EOF */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3554 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3555 if (Lstream_write (outstr, largebuf, chunk) < chunk)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3556 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3557 pos += chunk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3558 }
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 if (pos == nextpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3561 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3562 tem = Fcdr (Fcar (*annot));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3563 if (STRINGP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3564 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3565 if (Lstream_write (outstr, XSTRING_DATA (tem),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3566 XSTRING_LENGTH (tem)) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3567 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3568 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3569 *annot = Fcdr (*annot);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3570 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3571 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3572 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3573 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3574 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3575 }
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
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 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3580 #include <des_crypt.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3581
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3582 #define CRYPT_BLOCK_SIZE 8 /* bytes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3583 #define CRYPT_KEY_SIZE 8 /* bytes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3584
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3585 DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3586 Encrypt STRING using KEY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3587 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3588 (string, key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3589 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3590 char *encrypted_string, *raw_key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3591 int rounded_size, extra, key_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3592
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3593 /* !!#### May produce bogus data under Mule. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3594 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3595 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3597 extra = XSTRING_LENGTH (string) % CRYPT_BLOCK_SIZE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3598 rounded_size = XSTRING_LENGTH (string) + extra;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3599 encrypted_string = alloca (rounded_size + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3600 memcpy (encrypted_string, XSTRING_DATA (string), XSTRING_LENGTH (string));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3601 memset (encrypted_string + rounded_size - extra, 0, extra + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3602
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3603 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3604
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3605 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3606 memcpy (raw_key, XSTRING_DATA (key), key_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3607 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
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 ecb_crypt (raw_key, encrypted_string, rounded_size,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3610 DES_ENCRYPT | DES_SW);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3611 return make_string (encrypted_string, rounded_size);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3614 DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3615 Decrypt STRING using KEY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3616 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3617 (string, key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3618 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3619 char *decrypted_string, *raw_key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3620 int string_size, key_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3621
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3622 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3623 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3624
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3625 string_size = XSTRING_LENGTH (string) + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3626 decrypted_string = alloca (string_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3627 memcpy (decrypted_string, XSTRING_DATA (string), string_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3628 decrypted_string[string_size - 1] = '\0';
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 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3631
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3632 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3633 memcpy (raw_key, XSTRING_DATA (key), key_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3634 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3635
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 ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3638 return make_string (decrypted_string, string_size - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3639 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3640 #endif /* 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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3643 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
3644 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
3645 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
3646 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3647 (buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3648 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3649 /* This function can call lisp; GC checked 2000-07-11 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3650 struct buffer *b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3651 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3652 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3653
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3654 CHECK_BUFFER (buffer);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3655 b = XBUFFER (buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3656
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3657 if (!STRINGP (b->filename)) return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3658 if (b->modtime == 0) return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3659
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3660 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3661 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3662 handler = Ffind_file_name_handler (b->filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3663 Qverify_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3664 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3665 return call2 (handler, Qverify_visited_file_modtime, buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3666
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3667 if (xemacs_stat ((char *) XSTRING_DATA (b->filename), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3668 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3669 /* If the file doesn't exist now and didn't exist before,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3670 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
3671 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3672 st.st_mtime = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3673 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3674 st.st_mtime = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3675 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3676 if (st.st_mtime == b->modtime
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3677 /* 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
3678 || (st.st_mtime > 0 && b->modtime > 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3679 && (st.st_mtime == b->modtime + 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3680 || st.st_mtime == b->modtime - 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3681 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3682 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3683 }
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 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3686 Clear out records of last mod time of visited file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3687 Next attempt to save will certainly not complain of a discrepancy.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3688 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3689 ())
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 current_buffer->modtime = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3692 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3695 DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3696 Return the current buffer's recorded visited file modification time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3697 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
3698 that `file-attributes' returns.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3699 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3700 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3701 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3702 return time_to_lisp ((time_t) current_buffer->modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3703 }
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 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3706 Update buffer's recorded modification time from the visited file's time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3707 Useful if the buffer was not read from the file normally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3708 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
3709 An argument specifies the modification time value to use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3710 \(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
3711 \(HIGH . LOW) or (HIGH LOW).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3712 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3713 (time_list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3714 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3715 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3716 if (!NILP (time_list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3717 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3718 time_t the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3719 lisp_to_time (time_list, &the_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3720 current_buffer->modtime = (int) the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3721 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3722 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3723 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3724 Lisp_Object filename = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3725 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3726 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3727 struct gcpro gcpro1, gcpro2, gcpro3;
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 GCPRO3 (filename, time_list, current_buffer->filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3730 filename = Fexpand_file_name (current_buffer->filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3731
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3732 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3733 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3734 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3735 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3736 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3737 /* The handler can find the file name the same way we did. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3738 return call2 (handler, Qset_visited_file_modtime, Qnil);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3739 else if (xemacs_stat ((char *) XSTRING_DATA (filename), &st) >= 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3740 current_buffer->modtime = st.st_mtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3741 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3743 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3746 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3747 auto_save_error (Lisp_Object condition_object, Lisp_Object ignored)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3748 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3749 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3750 if (gc_in_progress)
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 /* Don't try printing an error message after everything is gone! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3753 if (preparing_for_armageddon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3754 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3755 clear_echo_area (selected_frame (), Qauto_saving, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3756 Fding (Qt, Qauto_save_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3757 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3758 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3759 message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3760 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3761 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3762 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3763 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3764 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3765
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3766 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3767 auto_save_1 (Lisp_Object ignored)
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 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3770 /* #### I think caller is protecting current_buffer? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3771 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3772 Lisp_Object fn = current_buffer->filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3773 Lisp_Object a = current_buffer->auto_save_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3774
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3775 if (!STRINGP (a))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3776 return (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3777
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3778 /* 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
3779 if (STRINGP (fn) &&
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3780 xemacs_stat ((char *) XSTRING_DATA (fn), &st) >= 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3781 /* But make sure we can overwrite it later! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3782 auto_save_mode_bits = st.st_mode | 0600;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3783 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3784 /* default mode for auto-save files of buffers with no file is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3785 readable by owner only. This may annoy some small number of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3786 people, but the alternative removes all privacy from email. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3787 auto_save_mode_bits = 0600;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3788
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3789 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3790 /* !!#### need to deal with this 'escape-quoted everywhere */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3791 Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3792 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3793 Qescape_quoted
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3794 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3795 Qnil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3796 #endif
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3800 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3801 auto_save_expand_name_error (Lisp_Object condition_object, Lisp_Object ignored)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3802 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3803 /* #### this function should spew an error message about not being
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3804 able to open the .saves file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3805 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3806 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3807
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3808 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3809 auto_save_expand_name (Lisp_Object name)
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 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3812
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3813 /* note that caller did NOT gc protect name, so we do it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3814 /* #### dmoore - this might not be necessary, if condition_case_1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3815 protects it. but I don't think it does. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3816 GCPRO1 (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3817 RETURN_UNGCPRO (Fexpand_file_name (name, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3818 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3820
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3821 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3822 do_auto_save_unwind (Lisp_Object fd)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3823 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3824 close (XINT (fd));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3825 return (fd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3826 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3827
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3828 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3829 do_auto_save_unwind_2 (Lisp_Object old_auto_saving)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3830 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3831 auto_saving = XINT (old_auto_saving);
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 /* 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
3836 and if so, tries to avoid touching lisp objects.
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 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
3839 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
3840 It's fairly important that we generate autosave files in that case!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3841 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3843 DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3844 Auto-save all buffers that need it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3845 This is all buffers that have auto-saving enabled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3846 and are changed since last auto-saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3847 Auto-saving writes the buffer into a file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3848 so that your editing is not lost if the system crashes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3849 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
3850 Normally we run the normal hook `auto-save-hook' before saving.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3852 Non-nil first argument means do not print any message if successful.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3853 Non-nil second argument means save only current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3854 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3855 (no_message, current_only))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3856 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3857 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3858 struct buffer *b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3859 Lisp_Object tail, buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3860 int auto_saved = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3861 int do_handled_files;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3862 Lisp_Object oquit = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3863 Lisp_Object listfile = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3864 Lisp_Object old;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3865 int listdesc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3866 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3867 struct gcpro gcpro1, gcpro2, gcpro3;
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 XSETBUFFER (old, current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3870 GCPRO3 (oquit, listfile, old);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3871 check_quit (); /* make Vquit_flag accurate */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3872 /* Ordinarily don't quit within this function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3873 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
3874 oquit = Vquit_flag;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3875 Vquit_flag = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3876
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3877 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3878 variables point to non-strings reached from Vbuffer_alist. */
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 if (minibuf_level != 0 || preparing_for_armageddon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3881 no_message = Qt;
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 run_hook (Qauto_save_hook);
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 if (STRINGP (Vauto_save_list_file_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3886 listfile = condition_case_1 (Qt,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3887 auto_save_expand_name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3888 Vauto_save_list_file_name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3889 auto_save_expand_name_error, 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 /* Make sure auto_saving is reset. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3892 record_unwind_protect (do_auto_save_unwind_2, make_int (auto_saving));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3893
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3894 auto_saving = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3895
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3896 /* First, save all files which don't have handlers. If Emacs is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3897 crashing, the handlers may tweak what is causing Emacs to crash
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3898 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
3899 autosave perfectly ordinary files because it couldn't handle some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3900 ange-ftp'd file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3901 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
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 for (tail = Vbuffer_alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3904 CONSP (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3905 tail = XCDR (tail))
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 buf = XCDR (XCAR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3908 b = XBUFFER (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3909
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3910 if (!NILP (current_only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3911 && b != current_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3912 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3913
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3914 /* Don't auto-save indirect buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3915 The base buffer takes care of it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3916 if (b->base_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3917 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3919 /* Check for auto save enabled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3920 and file changed since last auto save
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3921 and file changed since last real save. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3922 if (STRINGP (b->auto_save_file_name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3923 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3924 && b->auto_save_modified < BUF_MODIFF (b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3925 /* -1 means we've turned off autosaving for a while--see below. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3926 && XINT (b->saved_size) >= 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3927 && (do_handled_files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3928 || NILP (Ffind_file_name_handler (b->auto_save_file_name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3929 Qwrite_region))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3930 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3931 EMACS_TIME before_time, after_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3932
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3933 EMACS_GET_TIME (before_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3934 /* If we had a failure, don't try again for 20 minutes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3935 if (!preparing_for_armageddon
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3936 && b->auto_save_failure_time >= 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3937 && (EMACS_SECS (before_time) - b->auto_save_failure_time <
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3938 1200))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3939 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3941 if (!preparing_for_armageddon &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3942 (XINT (b->saved_size) * 10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3943 > (BUF_Z (b) - BUF_BEG (b)) * 13)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3944 /* A short file is likely to change a large fraction;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3945 spare the user annoying messages. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3946 && XINT (b->saved_size) > 5000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3947 /* These messages are frequent and annoying for `*mail*'. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3948 && !NILP (b->filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3949 && NILP (no_message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3950 && disable_auto_save_when_buffer_shrinks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3951 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3952 /* It has shrunk too much; turn off auto-saving here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3953 Unless we're about to crash, in which case auto-save it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3954 anyway.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3955 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3956 message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3957 ("Buffer %s has shrunk a lot; auto save turned off there",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3958 XSTRING_DATA (b->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3959 /* Turn off auto-saving until there's a real save,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3960 and prevent any more warnings. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3961 b->saved_size = make_int (-1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3962 if (!gc_in_progress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3963 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3964 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3965 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3966 set_buffer_internal (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3967 if (!auto_saved && NILP (no_message))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3968 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3969 static const unsigned char *msg
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3970 = (const unsigned char *) "Auto-saving...";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3971 echo_area_message (selected_frame (), msg, Qnil,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3972 0, strlen ((const char *) msg),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3973 Qauto_saving);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3974 }
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 /* Open the auto-save list file, if necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3977 We only do this now so that the file only exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3978 if we actually auto-saved any files. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3979 if (!auto_saved && !inhibit_auto_save_session
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3980 && !NILP (Vauto_save_list_file_prefix)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3981 && STRINGP (listfile) && listdesc < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3982 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3983 listdesc = open ((char *) XSTRING_DATA (listfile),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3984 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3985 CREAT_MODE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3986
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3987 /* Arrange to close that file whether or not we get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3988 an error. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3989 if (listdesc >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3990 record_unwind_protect (do_auto_save_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3991 make_int (listdesc));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3994 /* Record all the buffers that we are auto-saving in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3995 the special file that lists them. For each of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3996 these buffers, record visited name (if any) and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3997 auto save name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3998 if (listdesc >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3999 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4000 const Extbyte *auto_save_file_name_ext;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
4001 Bytecount auto_save_file_name_ext_len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4002
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4003 TO_EXTERNAL_FORMAT (LISP_STRING, b->auto_save_file_name,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4004 ALLOCA, (auto_save_file_name_ext,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4005 auto_save_file_name_ext_len),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4006 Qfile_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4007 if (!NILP (b->filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4008 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4009 const Extbyte *filename_ext;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
4010 Bytecount filename_ext_len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4011
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4012 TO_EXTERNAL_FORMAT (LISP_STRING, b->filename,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4013 ALLOCA, (filename_ext,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4014 filename_ext_len),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4015 Qfile_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4016 write (listdesc, filename_ext, filename_ext_len);
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 write (listdesc, "\n", 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4019 write (listdesc, auto_save_file_name_ext,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4020 auto_save_file_name_ext_len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4021 write (listdesc, "\n", 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4022 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4023
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4024 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4025 based on values in Vbuffer_alist. auto_save_1 may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4026 cause lisp handlers to run. Those handlers may kill
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4027 the buffer and then GC. Since the buffer is killed,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4028 it's no longer in Vbuffer_alist so it might get reaped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4029 by the GC. We also need to protect tail. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4030 /* #### There is probably a lot of other code which has
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4031 pointers into buffers which may get blown away by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4032 handlers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4033 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4034 struct gcpro ngcpro1, ngcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4035 NGCPRO2 (buf, tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4036 condition_case_1 (Qt,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4037 auto_save_1, Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4038 auto_save_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4039 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4040 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4041 /* Handler killed our saved current-buffer! Pick any. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4042 if (!BUFFER_LIVE_P (XBUFFER (old)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4043 XSETBUFFER (old, current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4044
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4045 set_buffer_internal (XBUFFER (old));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4046 auto_saved++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4047
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4048 /* Handler killed their own buffer! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4049 if (!BUFFER_LIVE_P(b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4050 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4051
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4052 b->auto_save_modified = BUF_MODIFF (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4053 b->saved_size = make_int (BUF_SIZE (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4054 EMACS_GET_TIME (after_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4055 /* If auto-save took more than 60 seconds,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4056 assume it was an NFS failure that got a timeout. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4057 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4058 b->auto_save_failure_time = EMACS_SECS (after_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4059 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4060 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4061 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4062
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4063 /* Prevent another auto save till enough input events come in. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4064 if (auto_saved)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4065 record_auto_save ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4066
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4067 /* If we didn't save anything into the listfile, remove the old
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4068 one because nothing needed to be auto-saved. Do this afterwards
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4069 rather than before in case we get a crash attempting to autosave
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4070 (in that case we'd still want the old one around). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4071 if (listdesc < 0 && !auto_saved && STRINGP (listfile))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4072 unlink ((char *) XSTRING_DATA (listfile));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4073
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4074 /* Show "...done" only if the echo area would otherwise be empty. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4075 if (auto_saved && NILP (no_message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4076 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4077 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4078 static const unsigned char *msg
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4079 = (const unsigned char *)"Auto-saving...done";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4080 echo_area_message (selected_frame (), msg, Qnil, 0,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4081 strlen ((const char *) msg), Qauto_saving);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4082 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4083
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4084 Vquit_flag = oquit;
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 RETURN_UNGCPRO (unbind_to (speccount, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4087 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4089 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4090 Mark current buffer as auto-saved with its current text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4091 No auto-save file will be written until the buffer changes again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4092 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4093 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4094 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4095 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4096 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4097 current_buffer->auto_save_failure_time = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4098 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4099 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4101 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
4102 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
4103 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4104 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4105 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4106 current_buffer->auto_save_failure_time = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4107 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4108 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4110 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4111 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
4112 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4113 ())
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 return (BUF_SAVE_MODIFF (current_buffer) <
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4116 current_buffer->auto_save_modified) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4117 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4118
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4120 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4121 /* initialization */
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4125 syms_of_fileio (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4126 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4127 DEFSYMBOL (Qexpand_file_name);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4128 DEFSYMBOL (Qfile_truename);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4129 DEFSYMBOL (Qsubstitute_in_file_name);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4130 DEFSYMBOL (Qdirectory_file_name);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4131 DEFSYMBOL (Qfile_name_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4132 DEFSYMBOL (Qfile_name_nondirectory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4133 DEFSYMBOL (Qunhandled_file_name_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4134 DEFSYMBOL (Qfile_name_as_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4135 DEFSYMBOL (Qcopy_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4136 DEFSYMBOL (Qmake_directory_internal);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4137 DEFSYMBOL (Qdelete_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4138 DEFSYMBOL (Qdelete_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4139 DEFSYMBOL (Qrename_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4140 DEFSYMBOL (Qadd_name_to_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4141 DEFSYMBOL (Qmake_symbolic_link);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4142 DEFSYMBOL (Qfile_exists_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4143 DEFSYMBOL (Qfile_executable_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4144 DEFSYMBOL (Qfile_readable_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4145 DEFSYMBOL (Qfile_symlink_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4146 DEFSYMBOL (Qfile_writable_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4147 DEFSYMBOL (Qfile_directory_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4148 DEFSYMBOL (Qfile_regular_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4149 DEFSYMBOL (Qfile_accessible_directory_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4150 DEFSYMBOL (Qfile_modes);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4151 DEFSYMBOL (Qset_file_modes);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4152 DEFSYMBOL (Qfile_newer_than_file_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4153 DEFSYMBOL (Qinsert_file_contents);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4154 DEFSYMBOL (Qwrite_region);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4155 DEFSYMBOL (Qverify_visited_file_modtime);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4156 DEFSYMBOL (Qset_visited_file_modtime);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4157 DEFSYMBOL (Qcar_less_than_car); /* Vomitous! */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4158
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4159 DEFSYMBOL (Qauto_save_hook);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4160 DEFSYMBOL (Qauto_save_error);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4161 DEFSYMBOL (Qauto_saving);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4162
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4163 DEFSYMBOL (Qformat_decode);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4164 DEFSYMBOL (Qformat_annotate_function);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4165
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4166 DEFSYMBOL (Qcompute_buffer_file_truename);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4167
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4168 DEFERROR_STANDARD (Qfile_already_exists, Qfile_error);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4170 DEFSUBR (Ffind_file_name_handler);
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 DEFSUBR (Ffile_name_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4173 DEFSUBR (Ffile_name_nondirectory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4174 DEFSUBR (Funhandled_file_name_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4175 DEFSUBR (Ffile_name_as_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4176 DEFSUBR (Fdirectory_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4177 DEFSUBR (Fmake_temp_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4178 DEFSUBR (Fexpand_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4179 DEFSUBR (Ffile_truename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4180 DEFSUBR (Fsubstitute_in_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4181 DEFSUBR (Fcopy_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4182 DEFSUBR (Fmake_directory_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4183 DEFSUBR (Fdelete_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4184 DEFSUBR (Fdelete_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4185 DEFSUBR (Frename_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4186 DEFSUBR (Fadd_name_to_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4187 DEFSUBR (Fmake_symbolic_link);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4188 #ifdef HPUX_NET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4189 DEFSUBR (Fsysnetunam);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4190 #endif /* HPUX_NET */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4191 DEFSUBR (Ffile_name_absolute_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4192 DEFSUBR (Ffile_exists_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4193 DEFSUBR (Ffile_executable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4194 DEFSUBR (Ffile_readable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4195 DEFSUBR (Ffile_writable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4196 DEFSUBR (Ffile_symlink_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4197 DEFSUBR (Ffile_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4198 DEFSUBR (Ffile_accessible_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4199 DEFSUBR (Ffile_regular_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4200 DEFSUBR (Ffile_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4201 DEFSUBR (Fset_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4202 DEFSUBR (Fset_default_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4203 DEFSUBR (Fdefault_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4204 DEFSUBR (Funix_sync);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4205 DEFSUBR (Ffile_newer_than_file_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4206 DEFSUBR (Finsert_file_contents_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4207 DEFSUBR (Fwrite_region_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4208 DEFSUBR (Fcar_less_than_car); /* Vomitous! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4209 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4210 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4211 DEFSUBR (Fencrypt_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4212 DEFSUBR (Fdecrypt_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4213 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4214 DEFSUBR (Fverify_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4215 DEFSUBR (Fclear_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4216 DEFSUBR (Fvisited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4217 DEFSUBR (Fset_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4219 DEFSUBR (Fdo_auto_save);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4220 DEFSUBR (Fset_buffer_auto_saved);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4221 DEFSUBR (Fclear_buffer_auto_save_failure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4222 DEFSUBR (Frecent_auto_save_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4223 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4225 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4226 vars_of_fileio (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4227 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4228 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4229 *Format in which to write auto-save files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4230 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
4231 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
4232 same format as a regular save would use.
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 Vauto_save_file_format = Qt;
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 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4237 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4238 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
4239 HANDLER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4241 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
4242 to be handled; the remaining arguments are the arguments that were
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4243 passed to that primitive. For example, if you do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4244 (file-exists-p FILENAME)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4245 and FILENAME is handled by HANDLER, then HANDLER is called like this:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4246 (funcall HANDLER 'file-exists-p FILENAME)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4247 The function `find-file-name-handler' checks this list for a handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4248 for its argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4249 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4250 Vfile_name_handler_alist = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4252 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4253 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
4254 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
4255 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
4256 intercepted by a handler from `file-name-handler-alist', that handler is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4257 responsible for calling the after-insert-file-functions if appropriate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4258 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4259 Vafter_insert_file_functions = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4260
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4261 DEFVAR_LISP ("write-region-annotate-functions",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4262 &Vwrite_region_annotate_functions /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4263 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
4264 Each is passed two arguments, START and END, as for `write-region'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4265 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
4266 effectively inserted at the specified positions of the file being written
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4267 \(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
4268 sorted into increasing order. If there are several functions in the list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4269 the several lists are merged destructively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4270 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4271 Vwrite_region_annotate_functions = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4273 DEFVAR_LISP ("write-region-annotations-so-far",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4274 &Vwrite_region_annotations_so_far /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4275 When an annotation function is called, this holds the previous annotations.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4276 These are the annotations made by other annotation functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4277 that were already called. See also `write-region-annotate-functions'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4278 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4279 Vwrite_region_annotations_so_far = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4281 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4282 A list of file name handlers that temporarily should not be used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4283 This applies only to the operation `inhibit-file-name-operation'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4284 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4285 Vinhibit_file_name_handlers = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4287 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4288 The operation for which `inhibit-file-name-handlers' is applicable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4289 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4290 Vinhibit_file_name_operation = Qnil;
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-list-file-name", &Vauto_save_list_file_name /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4293 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
4294 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4295 Vauto_save_list_file_name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4296
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4297 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
4298 Prefix for generating auto-save-list-file-name.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4299 Emacs's pid and the system name will be appended to
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4300 this prefix to create a unique file name.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4301 */ );
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4302 Vauto_save_list_file_prefix = build_string ("~/.saves-");
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4303
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4304 DEFVAR_BOOL ("inhibit-auto-save-session", &inhibit_auto_save_session /*
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4305 When non-nil, inhibit auto save list file creation.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4306 */ );
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4307 inhibit_auto_save_session = 0;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4308
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4309 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4310 &disable_auto_save_when_buffer_shrinks /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4311 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
4312 This is to prevent you from losing your edits if you accidentally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4313 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
4314 Saving the buffer normally turns auto-save back on.
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 disable_auto_save_when_buffer_shrinks = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4318 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4319 Directory separator character for built-in functions that return file names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4320 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4321 This variable affects the built-in functions only on Windows,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4322 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
4323 what the normal separator is.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4324 */ );
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4325 #ifdef WIN32_NATIVE
432
3a7e78e1142d Import from CVS: tag r21-2-24
cvs
parents: 428
diff changeset
4326 Vdirectory_sep_char = make_char ('\\');
3a7e78e1142d Import from CVS: tag r21-2-24
cvs
parents: 428
diff changeset
4327 #else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4328 Vdirectory_sep_char = make_char ('/');
432
3a7e78e1142d Import from CVS: tag r21-2-24
cvs
parents: 428
diff changeset
4329 #endif
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4330
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4331 reinit_vars_of_fileio ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4332 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4333
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4334 void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4335 reinit_vars_of_fileio (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4336 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4337 /* 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
4338 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
4339 two different XEmacs processes using the same binary on different
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4340 machines creating temp files in the same directory will be
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4341 unlucky enough to have the same pid. If we randomize using
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4342 process startup time, then in practice they will be unlikely to
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4343 collide. We use the microseconds field so that scripts that start
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4344 simultaneous XEmacs processes on multiple machines will have less
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4345 chance of collision. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4346 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4347 EMACS_TIME thyme;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4348
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4349 EMACS_GET_TIME (thyme);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4350 temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4351 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4352 }