annotate src/fileio.c @ 4407:4ee73bbe4f8e

Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings. 2007-12-26 Aidan Kehoe <kehoea@parhasard.net> * casetab.c: Extend and correct some case table documentation. * search.c (search_buffer): Correct a bug where only the first entry for a character in the case equivalence table was examined in determining if the Boyer-Moore search algorithm is appropriate. If there are case mappings outside of the charset and row of the characters specified in the search string, those case mappings can be safely ignored (and Boyer-Moore search can be used) if we know from the buffer statistics that the corresponding characters cannot occur. * search.c (boyer_moore): Assert that we haven't been passed a string with varying characters sets or rows within character sets. That's what simple_search is for. In the very rare event that a character in the search string has a canonical case mapping that is not in the same character set and row, don't try to search for the canonical character, search for some other character that is in the the desired character set and row. Assert that the case table isn't corrupt. Do not search for any character case mappings that cannot possibly occur in the buffer, given the buffer metadata about its contents.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 26 Dec 2007 17:30:16 +0100
parents 5e526366d533
children 1e04b9c8125b
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.
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
3 Copyright (C) 1996, 2001, 2002, 2003, 2004 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Mule 2.0, FSF 19.30. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
23 /* More syncing: FSF Emacs 19.34.6 by Marc Paquette <marcpa@cam.org>
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
24 (Note: Sync messages from Marc Paquette may indicate
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
25 incomplete synching, so beware.) */
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
26 /* Some functions synched with FSF 21.0.103. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
27 /* Mule-ized completely except for the #if 0-code including decrypt-string
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
28 and encrypt-string. --ben 7-2-00 */
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
29 /* #if 0-code Mule-ized, 2-22-03. --ben */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
30
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "buffer.h"
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
36 #include "device.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "events.h"
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
38 #include "file-coding.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #include "insdel.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 #include "lstream.h"
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
42 #include "profile.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
43 #include "process.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 #include "redisplay.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #include "sysdep.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
46 #include "window-impl.h"
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
47
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #include "sysfile.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #include "sysproc.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 #include "syspwd.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 #include "systime.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 #include "sysdir.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 #ifdef HPUX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 #include <netio.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 #ifdef HPUX_PRE_8_0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 #include <errnet.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 #endif /* HPUX_PRE_8_0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 #endif /* HPUX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
1315
70921960b980 [xemacs-hg @ 2003-02-20 08:19:28 by ben]
ben
parents: 1204
diff changeset
61 #ifdef WIN32_ANY
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
62 #define WIN32_FILENAMES
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
63 #include "syswindows.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 #define IS_DRIVE(x) isalpha (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 /* Need to lower-case the drive letter, or else expanded
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 filenames will sometimes compare inequal, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 `expand-file-name' doesn't always down-case the drive letter. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 #define DRIVE_LETTER(x) tolower (x)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
69 #endif /* WIN32_NATIVE || CYGWIN */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 int lisp_to_time (Lisp_Object, time_t *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 Lisp_Object time_to_lisp (time_t);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 /* Nonzero during writing of auto-save files */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 static int auto_saving;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 /* 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
78 will create a new file with the same mode as the original */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 static int auto_save_mode_bits;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 /* Alist of elements (REGEXP . HANDLER) for file names
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 whose I/O is done with a special handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 Lisp_Object Vfile_name_handler_alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 /* Format for auto-save files */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 Lisp_Object Vauto_save_file_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 /* Lisp functions for translating file formats */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 Lisp_Object Qformat_decode, Qformat_annotate_function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 /* Functions to be called to process text properties in inserted file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 Lisp_Object Vafter_insert_file_functions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 /* Functions to be called to create text property annotations for file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 Lisp_Object Vwrite_region_annotate_functions;
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 /* During build_annotations, each time an annotation function is called,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 this holds the annotations made by the previous functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 Lisp_Object Vwrite_region_annotations_so_far;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 /* 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
102 Lisp_Object Vauto_save_list_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
104 /* Prefix used to construct Vauto_save_list_file_name. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
105 Lisp_Object Vauto_save_list_file_prefix;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
106
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
107 /* When non-nil, it prevents auto-save list file creation. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
108 int inhibit_auto_save_session;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
109
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 int disable_auto_save_when_buffer_shrinks;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 Lisp_Object Vdirectory_sep_char;
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 /* These variables describe handlers that have "already" had a chance
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 to handle the current operation.
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 Vinhibit_file_name_handlers is a list of file name handlers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 Vinhibit_file_name_operation is the operation being handled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 If we try to handle that operation, we ignore those handlers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 static Lisp_Object Vinhibit_file_name_handlers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 static Lisp_Object Vinhibit_file_name_operation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
124 Lisp_Object Qfile_already_exists;
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
125 Lisp_Object Qexcl;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 Lisp_Object Qauto_save_hook;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 Lisp_Object Qauto_save_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 Lisp_Object Qauto_saving;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 Lisp_Object Qcar_less_than_car;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 Lisp_Object Qcompute_buffer_file_truename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
135 Lisp_Object QSin_expand_file_name;
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
136
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 EXFUN (Frunning_temacs_p, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
139 /* DATA can be anything acceptable to signal_error ().
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
140 */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
141
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
142 DOESNT_RETURN
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
143 report_file_type_error (Lisp_Object errtype, Lisp_Object oserrmess,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
144 const CIbyte *string, Lisp_Object data)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
145 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
146 struct gcpro gcpro1;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
147 Lisp_Object errdata = build_error_data (NULL, data);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
148
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
149 GCPRO1 (errdata);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
150 errdata = Fcons (build_msg_string (string),
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
151 Fcons (oserrmess, errdata));
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
152 signal_error_1 (errtype, errdata);
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
153 /* UNGCPRO; not reached */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
154 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
155
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
156 DOESNT_RETURN
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
157 report_error_with_errno (Lisp_Object errtype,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
158 const CIbyte *string, Lisp_Object data)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
159 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
160 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
161 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
162
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 /* signal a file error when errno contains a meaningful value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 DOESNT_RETURN
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
166 report_file_error (const CIbyte *string, Lisp_Object data)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
168 report_error_with_errno (Qfile_error, string, data);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 /* Just like strerror(3), except return a lisp string instead of char *.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 The string needs to be converted since it may be localized.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
174 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 lisp_strerror (int errnum)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
178 Extbyte *ret = strerror (errnum);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
179 if (!ret)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
180 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
181 Ibyte ffff[99];
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
182 qxesprintf (ffff, "Unknown error %d", errnum);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
183 return build_intstring (ffff);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
184 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
185 return build_ext_string (ret, Qstrerror_encoding);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 close_file_unwind (Lisp_Object fd)
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 if (CONSP (fd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 if (INTP (XCAR (fd)))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
194 retry_close (XINT (XCAR (fd)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
196 free_cons (fd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
199 retry_close (XINT (fd));
428
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 delete_stream_unwind (Lisp_Object stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 Lstream_delete (XLSTREAM (stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 /* Restore point, having saved it as a marker. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 restore_point_unwind (Lisp_Object point_marker)
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 BUF_SET_PT (current_buffer, marker_position (point_marker));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 return Fset_marker (point_marker, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 Lisp_Object Qexpand_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 Lisp_Object Qfile_truename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 Lisp_Object Qsubstitute_in_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 Lisp_Object Qdirectory_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 Lisp_Object Qfile_name_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 Lisp_Object Qfile_name_nondirectory;
996
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 988
diff changeset
227 Lisp_Object Qfile_name_sans_extension;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 Lisp_Object Qunhandled_file_name_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 Lisp_Object Qfile_name_as_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 Lisp_Object Qcopy_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 Lisp_Object Qmake_directory_internal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 Lisp_Object Qdelete_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 Lisp_Object Qdelete_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 Lisp_Object Qrename_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 Lisp_Object Qadd_name_to_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 Lisp_Object Qmake_symbolic_link;
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
237 Lisp_Object Qmake_temp_name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 Lisp_Object Qfile_exists_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 Lisp_Object Qfile_executable_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 Lisp_Object Qfile_readable_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 Lisp_Object Qfile_symlink_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 Lisp_Object Qfile_writable_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 Lisp_Object Qfile_directory_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 Lisp_Object Qfile_regular_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 Lisp_Object Qfile_accessible_directory_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 Lisp_Object Qfile_modes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 Lisp_Object Qset_file_modes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 Lisp_Object Qfile_newer_than_file_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 Lisp_Object Qinsert_file_contents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 Lisp_Object Qwrite_region;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 Lisp_Object Qverify_visited_file_modtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 Lisp_Object Qset_visited_file_modtime;
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 /* If FILENAME is handled specially on account of its syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 return its handler function. Otherwise, return nil. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 DEFUN ("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 Return FILENAME's handler function for OPERATION, if it has one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 Otherwise, return nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 A file name is handled if one of the regular expressions in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 `file-name-handler-alist' matches it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 If OPERATION equals `inhibit-file-name-operation', then we ignore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 any handlers that are members of `inhibit-file-name-handlers',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 but we still do run any other handlers. This lets handlers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 use the standard functions without calling themselves recursively.
751
358bd84dc7ff [xemacs-hg @ 2002-02-13 12:55:38 by stephent]
stephent
parents: 707
diff changeset
267
358bd84dc7ff [xemacs-hg @ 2002-02-13 12:55:38 by stephent]
stephent
parents: 707
diff changeset
268 Otherwise, OPERATION is the name of a funcall'able function.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 (filename, operation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 /* This function does not GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 /* This function can be called during GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 /* This function must not munge the match data. */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
275 Lisp_Object inhibited_handlers;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 if (EQ (operation, Vinhibit_file_name_operation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 inhibited_handlers = Vinhibit_file_name_handlers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 inhibited_handlers = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
284 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
285 EXTERNAL_LIST_LOOP_2 (elt, Vfile_name_handler_alist)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
286 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
287 if (CONSP (elt))
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
288 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
289 Lisp_Object string = XCAR (elt);
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
290 if (STRINGP (string)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
291 && (fast_lisp_string_match (string, filename) >= 0))
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
292 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
293 Lisp_Object handler = XCDR (elt);
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
294 if (NILP (Fmemq (handler, inhibited_handlers)))
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
295 return handler;
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
296 }
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
297 }
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
298 }
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
299 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 call2_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 Lisp_Object result = call2 (fn, arg0, arg1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 CHECK_STRING (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 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
314 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 Lisp_Object result = call2 (fn, arg0, arg1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 if (!NILP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 CHECK_STRING (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 call3_check_string (Lisp_Object fn, Lisp_Object arg0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 Lisp_Object arg1, Lisp_Object arg2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 Lisp_Object result = call3 (fn, arg0, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 CHECK_STRING (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 }
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
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
333
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
334 Ibyte *
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
335 find_end_of_directory_component (const Ibyte *path, Bytecount len)
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
336 {
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
337 const Ibyte *p = path + len;
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
338
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
339 while (p != path && !IS_DIRECTORY_SEP (p[-1])
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
340 #ifdef WIN32_FILENAMES
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
341 /* only recognise drive specifier at the beginning */
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
342 && !(p[-1] == ':'
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
343 /* handle the "/:d:foo" and "/:foo" cases correctly */
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
344 && ((p == path + 2 && !IS_DIRECTORY_SEP (*path))
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
345 || (p == path + 4 && IS_DIRECTORY_SEP (*path))))
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
346 #endif
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
347 ) p--;
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
348
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
349 return (Ibyte *) p;
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
350 }
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
351
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
353 Return the directory component in file name FILENAME.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
354 Return nil if FILENAME does not include a directory.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 Otherwise return a directory spec.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 Given a Unix syntax file name, returns a string ending in slash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
358 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
360 /* This function can GC. GC checked 2000-07-28 ben */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
361 /* This function synched with Emacs 21.0.103. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
362 Ibyte *beg;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
363 Ibyte *p;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
366 CHECK_STRING (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
370 handler = Ffind_file_name_handler (filename, Qfile_name_directory);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
372 return call2_check_string_or_nil (handler, Qfile_name_directory, filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 #ifdef FILE_SYSTEM_CASE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
375 filename = FILE_SYSTEM_CASE (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
377 beg = XSTRING_DATA (filename);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
378 /* XEmacs: no need to alloca-copy here */
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
379 p = find_end_of_directory_component (beg, XSTRING_LENGTH (filename));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 if (p == beg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 return Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
383 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 /* Expansion of "c:" to drive and default directory. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
385 if (p[-1] == ':')
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
387 Ibyte *res;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
388 Ibyte *wd = mswindows_getdcwd (toupper (*beg) - 'A' + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
389
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
390 res = alloca_ibytes ((wd ? qxestrlen (wd) : 0) + 10); /* go overboard */
1116
3bcd77d0bf93 [xemacs-hg @ 2002-11-22 12:57:09 by ben]
ben
parents: 1111
diff changeset
391 res[0] = '\0';
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
392 if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
393 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
394 qxestrncpy (res, beg, 2);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
395 beg += 2;
1116
3bcd77d0bf93 [xemacs-hg @ 2002-11-22 12:57:09 by ben]
ben
parents: 1111
diff changeset
396 res[2] = '\0';
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
397 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
398
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
399 if (wd)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 {
3648
3e7493e76dc7 [xemacs-hg @ 2006-11-01 20:25:48 by adrian]
adrian
parents: 3638
diff changeset
401 int size;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
402 qxestrcat (res, wd);
3648
3e7493e76dc7 [xemacs-hg @ 2006-11-01 20:25:48 by adrian]
adrian
parents: 3638
diff changeset
403 size = qxestrlen (res);
3e7493e76dc7 [xemacs-hg @ 2006-11-01 20:25:48 by adrian]
adrian
parents: 3638
diff changeset
404 if (!IS_DIRECTORY_SEP (res[size - 1]))
3e7493e76dc7 [xemacs-hg @ 2006-11-01 20:25:48 by adrian]
adrian
parents: 3638
diff changeset
405 {
3e7493e76dc7 [xemacs-hg @ 2006-11-01 20:25:48 by adrian]
adrian
parents: 3638
diff changeset
406 res[size] = DIRECTORY_SEP;
3e7493e76dc7 [xemacs-hg @ 2006-11-01 20:25:48 by adrian]
adrian
parents: 3638
diff changeset
407 res[size + 1] = '\0';
3e7493e76dc7 [xemacs-hg @ 2006-11-01 20:25:48 by adrian]
adrian
parents: 3638
diff changeset
408 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 beg = res;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
410 p = beg + qxestrlen (beg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 }
3648
3e7493e76dc7 [xemacs-hg @ 2006-11-01 20:25:48 by adrian]
adrian
parents: 3638
diff changeset
412 else
3e7493e76dc7 [xemacs-hg @ 2006-11-01 20:25:48 by adrian]
adrian
parents: 3638
diff changeset
413 {
3e7493e76dc7 [xemacs-hg @ 2006-11-01 20:25:48 by adrian]
adrian
parents: 3638
diff changeset
414 return Qnil;
3e7493e76dc7 [xemacs-hg @ 2006-11-01 20:25:48 by adrian]
adrian
parents: 3638
diff changeset
415 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
416 if (wd)
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1333
diff changeset
417 xfree (wd, Ibyte *);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
419
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
420 #if 0 /* No! This screws up efs, which calls file-name-directory on URL's
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
421 and expects the slashes to be left alone. This is here because of
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
422 an analogous call in FSF 21. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
423 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
424 Bytecount len = p - beg;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
425 Ibyte *newbeg = alloca_ibytes (len + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
426
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
427 qxestrncpy (newbeg, beg, len);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
428 newbeg[len] = '\0';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
429 newbeg = mswindows_canonicalize_filename (newbeg);
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1333
diff changeset
430 return build_intstring (newbeg);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
431 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
432 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
433 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 return make_string (beg, p - beg);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
438 Return file name FILENAME sans its directory.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 For example, in a Unix-syntax file name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 this is everything after the last slash,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 or the entire name if it contains no slash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
443 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
445 /* This function can GC. GC checked 2000-07-28 ben */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
446 /* This function synched with Emacs 21.0.103. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
447 Ibyte *beg, *p, *end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
450 CHECK_STRING (filename);
428
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 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
454 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
456 return call2_check_string (handler, Qfile_name_nondirectory, filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
457
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
458 beg = XSTRING_DATA (filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
459 end = p = beg + XSTRING_LENGTH (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
461 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
462 #ifdef WIN32_FILENAMES
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
463 /* only recognise drive specifier at beginning */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
464 && !(p[-1] == ':'
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
465 /* handle the "/:d:foo" case correctly */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
466 && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 #endif
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
468 )
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
469 p--;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 return make_string (p, end - p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 Return a directly usable directory name somehow associated with FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 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
477 intervention of any file handler.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 If FILENAME is a directly usable file itself, return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 \(file-name-directory FILENAME).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 The `call-process' and `start-process' functions use this function to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 get a current directory to run processes in.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
483 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
485 /* This function can GC. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 Lisp_Object handler;
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 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 return call2 (handler, Qunhandled_file_name_directory,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 return Ffile_name_directory (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
499 static Ibyte *
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
500 file_name_as_directory (Ibyte *out, Ibyte *in)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
502 /* This function cannot GC */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
503 int size = qxestrlen (in);
428
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 if (size == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 out[0] = '.';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 out[1] = DIRECTORY_SEP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 out[2] = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
513 qxestrcpy (out, in);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 /* Append a slash if necessary */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 if (!IS_ANY_SEP (out[size-1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 out[size] = DIRECTORY_SEP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 out[size + 1] = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 return out;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 Return a string representing file FILENAME interpreted as a directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 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
527 a directory is different from its name as a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 The result can be used as the value of `default-directory'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 or passed as second argument to `expand-file-name'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 For a Unix-syntax file name, just appends a slash,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 except for (file-name-as-directory \"\") => \"./\".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
533 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
535 /* This function can GC. GC checked 2000-07-28 ben */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
536 Ibyte *buf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
539 CHECK_STRING (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
543 handler = Ffind_file_name_handler (filename, Qfile_name_as_directory);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
545 return call2_check_string (handler, Qfile_name_as_directory, filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
546
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
547 buf = alloca_ibytes (XSTRING_LENGTH (filename) + 10);
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
548 file_name_as_directory (buf, XSTRING_DATA (filename));
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
549 if (qxestrcmp (buf, XSTRING_DATA (filename)))
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
550 return build_intstring (buf);
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
551 else
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
552 return filename;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 * Convert from directory name to filename.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 * 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
558 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 * Value is nonzero if the string output is different from the input.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 static int
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
563 directory_file_name (const Ibyte *src, Ibyte *dst)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
565 /* This function cannot GC */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
566 long slen = qxestrlen (src);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 /* Process as Unix format: just remove any final slash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 But leave "/" unchanged; do not change it to "". */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
569 qxestrcpy (dst, src);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 if (slen > 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 && IS_DIRECTORY_SEP (dst[slen - 1])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
572 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 && !IS_ANY_SEP (dst[slen - 2])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
574 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 dst[slen - 1] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
581 Return the file name of the directory named DIRECTORY.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
582 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
583 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
584 a directory is different from its name as a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 In Unix-syntax, this function just removes the final slash.
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 (directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
589 /* This function can GC. GC checked 2000-07-28 ben */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
590 Ibyte *buf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 Lisp_Object handler;
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 CHECK_STRING (directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 #if 0 /* #### WTF? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 if (NILP (directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 return call2_check_string (handler, Qdirectory_file_name, directory);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
605 buf = alloca_ibytes (XSTRING_LENGTH (directory) + 20);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
606 directory_file_name (XSTRING_DATA (directory), buf);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
607 return build_intstring (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 /* 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
611 proved too broken for our purposes (it supported only 26 or 62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 unique names under some implementations). For example, this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 arbitrary limit broke generation of Gnus Incoming* files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 This implementation is better than what one usually finds in libc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 --hniksic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
618 static unsigned int temp_name_rand;
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 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
621 Generate a temporary file name starting with PREFIX.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 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
623 danger of generating a name being used by another process.
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 In addition, this function makes an attempt to choose a name that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 does not specify an existing file. To make this work, PREFIX should
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
627 be an absolute file name.
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
628
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
629 This function is analagous to mktemp(3) under POSIX, and as with it, there
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
630 exists a race condition between the test for the existence of the new file
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
631 and its creation. See `make-temp-name' for a function which avoids this
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
632 race condition by specifying the appropriate flags to `write-region'.
428
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 (prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
636 static const char tbl[64] =
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
637 {
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 'A','B','C','D','E','F','G','H',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 'I','J','K','L','M','N','O','P',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 'Q','R','S','T','U','V','W','X',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 'Y','Z','a','b','c','d','e','f',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 'g','h','i','j','k','l','m','n',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 'o','p','q','r','s','t','u','v',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 'w','x','y','z','0','1','2','3',
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
645 '4','5','6','7','8','9','-','_'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
646 };
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 Bytecount len;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
649 Ibyte *p, *data;
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
650 Lisp_Object handler;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 CHECK_STRING (prefix);
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
653 handler = Ffind_file_name_handler (prefix, Qmake_temp_name);
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
654 if (!NILP (handler))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
655 return call2_check_string (handler, Qmake_temp_name, prefix);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 /* 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
658 a bad idea because:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 1) It might change the prefix, so the resulting string might not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 begin with PREFIX. This violates the principle of least
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 surprise.
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 2) It breaks under many unforeseeable circumstances, such as with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 the code that uses (make-temp-name "") instead of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 (make-temp-name "./").
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
668 [[ 3) It might yield unexpected (to stat(2)) results in the presence
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
669 of EFS and file name handlers.]] Now that we check for a handler,
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
670 that's less of a concern. --ben */
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 len = XSTRING_LENGTH (prefix);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
673 data = alloca_ibytes (len + 7);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 memcpy (data, XSTRING_DATA (prefix), len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 p = data + len;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
676 p[6] = '\0';
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 /* VAL is created by adding 6 characters to PREFIX. The first three
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 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
680 a pseudo-random number seeded from process startup time. This
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
681 ensures 262144 unique file names per PID per PREFIX per machine. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
682
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
683 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
684 unsigned int pid = (unsigned int) qxe_getpid ();
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
685 *p++ = tbl[(pid >> 0) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
686 *p++ = tbl[(pid >> 6) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
687 *p++ = tbl[(pid >> 12) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
688 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 /* Here we try to minimize useless stat'ing when this function is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 invoked many times successively with the same PREFIX. We achieve
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
692 this by using a very pseudo-random number generator to generate
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
693 file names unique to this process, with a very long cycle. */
428
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 while (1)
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 struct stat ignored;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
698
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
699 p[0] = tbl[(temp_name_rand >> 0) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
700 p[1] = tbl[(temp_name_rand >> 6) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
701 p[2] = tbl[(temp_name_rand >> 12) & 63];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 /* Poor man's congruential RN generator. Replace with ++count
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 for debugging. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
705 temp_name_rand += 25229;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
706 temp_name_rand %= 225307;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
710 if (qxe_stat (data, &ignored) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 /* We want to return only if errno is ENOENT. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 if (errno == ENOENT)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
714 return make_string (data, len + 6);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 /* The error here is dubious, but there is little else we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 can do. The alternatives are to return nil, which is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 as bad as (and in many cases worse than) throwing the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 error, or to ignore the error, which will likely result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 in inflooping. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 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
722 prefix);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 return Qnil; /* not reached */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
729
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 Convert filename NAME to absolute, and canonicalize it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 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
733 (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
734 the current buffer's value of `default-directory' is used.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 File name components that are `.' are removed, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 so are file name components followed by `..', along with the `..' itself;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 note that these simplifications are done without checking the resulting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 file names in the file system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 An initial `~/' expands to your home directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 An initial `~USER/' expands to USER's home directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 See also the function `substitute-in-file-name'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 (name, default_directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
745 /* This function can GC. GC-checked 2000-11-18.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
746 This function synched with Emacs 21.0.103. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
747 Ibyte *nm;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
748
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
749 Ibyte *newdir, *p, *o;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 int tlen;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
751 Ibyte *target;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
752 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 int drive = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 int collapse_newdir = 1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
755 /* XEmacs note: This concerns the special '/:' syntax for preventing
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
756 wildcards and such. We don't support this currently but I'm
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
757 keeping the code here in case we do. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
758 int is_escaped = 0;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
759 #endif
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
760 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 struct passwd *pw;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
762 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 int length;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
764 Lisp_Object handler = Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
765 struct gcpro gcpro1, gcpro2, gcpro3;
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
766 PROFILE_DECLARE ();
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
767
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
768 PROFILE_RECORD_ENTERING_SECTION (QSin_expand_file_name);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
769
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
770 /* both of these get set below */
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
771 GCPRO3 (name, default_directory, handler);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 CHECK_STRING (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 handler = Ffind_file_name_handler (name, Qexpand_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 if (!NILP (handler))
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
779 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name,
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
780 call3_check_string
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
781 (handler, Qexpand_file_name,
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
782 name, default_directory));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 if (NILP (default_directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 default_directory = current_buffer->directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 if (! STRINGP (default_directory))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
788 #ifdef WIN32_NATIVE
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
789 default_directory = build_string ("C:\\");
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
790 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 default_directory = build_string ("/");
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
792 #endif
428
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 if (!NILP (default_directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 if (!NILP (handler))
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
798 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name,
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
799 call3 (handler, Qexpand_file_name,
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
800 name, default_directory));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 o = XSTRING_DATA (default_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 /* Make sure DEFAULT_DIRECTORY is properly expanded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 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
807 default_directory. Unfortunately, calling Fexpand_file_name recursively
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 could invoke GC, and the strings might be relocated. This would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 be annoying because we have pointers into strings lying around
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 that would need adjusting, and people would add new pointers to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 the code and forget to adjust them, resulting in intermittent bugs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 Putting this call here avoids all that crud.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 The EQ test avoids infinite recursion. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 if (! NILP (default_directory) && !EQ (default_directory, name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 /* Save time in some common cases - as long as default_directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 is not relative, it can be canonicalized with name below (if it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 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
819 #ifdef WIN32_FILENAMES
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
820 /* Detect Windows file names with drive specifiers. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 && ! (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
822 /* Detect Windows file names in UNC format. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 && ! (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
824 #endif /* not WIN32_FILENAMES */
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
825 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 /* Detect Unix absolute file names (/... alone is not absolute on
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
827 Windows). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 && ! (IS_DIRECTORY_SEP (o[0]))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
829 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 )
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
831
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
832 default_directory = Fexpand_file_name (default_directory, Qnil);
428
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 #ifdef FILE_SYSTEM_CASE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 name = FILE_SYSTEM_CASE (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 into name should be safe during all of this, though. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 nm = XSTRING_DATA (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
842 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 /* We will force directory separators to be either all \ or /, so make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 a local copy to modify, even if there ends up being no change. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
845 nm = qxestrcpy (alloca_ibytes (qxestrlen (nm) + 1), nm);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
846
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
847 /* Note if special escape prefix is present, but remove for now. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
848 if (nm[0] == '/' && nm[1] == ':')
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
849 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
850 is_escaped = 1;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
851 nm += 2;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
852 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 /* Find and remove drive specifier if present; this makes nm absolute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 even if the rest of the name appears to be relative. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
857 Ibyte *colon = qxestrrchr (nm, ':');
428
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 if (colon)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
860 {
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 /* Only recognize colon as part of drive specifier if there is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 single alphabetic character preceding the colon (and if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 character before the drive letter, if present, is a directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 separator); this is to support the remote system syntax used by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 ange-ftp, and the "po:username" syntax for POP mailboxes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 look_again:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 if (nm == colon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 nm++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 else if (IS_DRIVE (colon[-1])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 drive = colon[-1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 nm = colon + 1;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 while (--colon >= nm)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 if (colon[0] == ':')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 goto look_again;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
881 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 /* 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
885 colon when stripping the drive letter. Otherwise, this expands to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 "//somedir". */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 nm++;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
889 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
891 #ifdef WIN32_FILENAMES
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
892 /* Discard any previous drive specifier if nm is now in UNC format. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
893 if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
894 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
895 drive = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
896 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
897 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
898
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 /* If nm is absolute, look for /./ or /../ sequences; if none are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 found, we can probably return right away. We will avoid allocating
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 a new string if name is already fully expanded. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 if (
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 IS_DIRECTORY_SEP (nm[0])
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
904 #ifdef WIN32_NATIVE
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
905 && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 #endif
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 /* 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
910 suffix of FILENAME, we don't need to go through and edit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 things; we just need to construct a new string using data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 starting at the middle of FILENAME. If we set lose to a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 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
914 that cool trick. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 int lose = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 p = nm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 while (*p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 /* Since we know the name is absolute, we can assume that each
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 element starts with a "/". */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 /* "." and ".." are hairy. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 if (IS_DIRECTORY_SEP (p[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 && p[1] == '.'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 && (IS_DIRECTORY_SEP (p[2])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 || p[2] == 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 || p[3] == 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 lose = 1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
931 /* We want to replace multiple `/' in a row with a single
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
932 slash. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
933 else if (p > nm
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
934 && IS_DIRECTORY_SEP (p[0])
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
935 && IS_DIRECTORY_SEP (p[1]))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
936 lose = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 if (!lose)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 {
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
941 #ifdef WIN32_FILENAMES
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
942 if (drive || IS_DIRECTORY_SEP (nm[1]))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
944 Ibyte *newnm;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
945
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
946 if (IS_DIRECTORY_SEP (nm[1]))
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
947 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
948 newnm = mswindows_canonicalize_filename (nm);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
949 if (qxestrcmp (newnm, XSTRING_DATA (name)) != 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
950 name = build_intstring (newnm);
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
951 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
952 else
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
953 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
954 /* drive must be set, so this is okay */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
955 newnm = mswindows_canonicalize_filename (nm - 2);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
956 if (qxestrcmp (newnm, XSTRING_DATA (name)) != 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
957 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
958 name = build_intstring (newnm);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
959 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
960 XSTRING_DATA (name)[1] = ':';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
961 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
962 }
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1333
diff changeset
963 xfree (newnm, Ibyte *);
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
964 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
966 #endif /* WIN32_FILENAMES */
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
967 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 if (nm == XSTRING_DATA (name))
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
969 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, name);
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
970 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name,
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
971 build_intstring (nm));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
972 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 /* 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
977 need to expand ~ or ~user if present, otherwise prefix nm with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 default_directory if nm is not absolute, and finally collapse /./
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 and /foo/../ sequences.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 We set newdir to be the appropriate prefix if one is needed:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 - the relevant user directory if nm starts with ~ or ~user
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 - 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
984 start with /
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 - the value of default_directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 Note that these prefixes are not guaranteed to be absolute (except
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 for the working dir of a drive). Therefore, to ensure we always
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 return an absolute name, if the final prefix is not absolute we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 append it to the current working directory. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 newdir = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 if (nm[0] == '~') /* prefix ~ */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 if (IS_DIRECTORY_SEP (nm[1])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 || nm[1] == 0) /* ~ by itself */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
999 Ibyte *homedir = get_home_directory ();
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1000
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1001 if (!homedir)
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1002 newdir = (Ibyte *) "";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1004 newdir = homedir;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 nm++;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1007 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 collapse_newdir = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 else /* ~user/filename */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 DO_NOTHING;
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1015 o = alloca_ibytes (p - nm + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1016 memcpy (o, nm, p - nm);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 o [p - nm] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 462
diff changeset
1019 /* #### 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
1020 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
1021 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
1022 ~user. --ben */
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 462
diff changeset
1023 #ifndef WIN32_NATIVE
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1024 #ifdef CYGWIN
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1025 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1026 Ibyte *user;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1027
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1028 if ((user = user_login_name (NULL)) != NULL)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1029 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1030 /* Does the user login name match the ~name? */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1031 if (qxestrcmp (user, o + 1) == 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1032 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1033 newdir = get_home_directory ();
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1034 nm = p;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1035 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1036 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1037 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1038 if (!newdir)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1040 #endif /* CYGWIN */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 occurring in it. (It can call select()). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 slow_down_interrupts ();
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1044 pw = (struct passwd *) qxe_getpwnam (o + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 speed_up_interrupts ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 if (pw)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1048 newdir = (Ibyte *) pw->pw_dir;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 nm = p;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1050 /* FSF: if WIN32_NATIVE, collapse_newdir = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1051 not possible here. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1053 #ifdef CYGWIN
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 #endif
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1056 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 /* 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
1059 unchanged; don't move nm forward to p. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 }
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
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1063 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 /* 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
1065 use the drive's current directory as the prefix if needed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 if (!newdir && drive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 {
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1068 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 /* Get default directory if needed to make nm absolute. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 if (!IS_DIRECTORY_SEP (nm[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1072 Ibyte *newcwd = mswindows_getdcwd (toupper (drive) - 'A' + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1073 if (newcwd)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1074 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1075 IBYTE_STRING_TO_ALLOCA (newcwd, newdir);
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1333
diff changeset
1076 xfree (newcwd, Ibyte *);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1077 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1078 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 newdir = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1081 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 if (!newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 /* Either nm starts with /, or drive isn't mounted. */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1085 newdir = alloca_ibytes (4);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 newdir[0] = DRIVE_LETTER (drive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 newdir[1] = ':';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 newdir[2] = '/';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 newdir[3] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1092 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 /* Finally, if no prefix has been specified and nm is not absolute,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 then it must be expanded relative to default_directory. */
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 (1
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1098 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 /* /... alone is not absolute on DOS and Windows. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 && !IS_DIRECTORY_SEP (nm[0])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1101 #endif
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1102 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 && !newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 newdir = XSTRING_DATA (default_directory);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1108 #ifdef WIN32_FILENAMES
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1109 /* Note if special escape prefix is present, but remove for now. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1110 if (newdir[0] == '/' && newdir[1] == ':')
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1111 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1112 is_escaped = 1;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1113 newdir += 2;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1114 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1115 #endif
428
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
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1118 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 if (newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 /* First ensure newdir is an absolute name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 if (
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1123 /* Detect Windows file names with drive specifiers. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 ! (IS_DRIVE (newdir[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 /* Detect Windows file names in UNC format. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1128 /* XEmacs: added these two lines: Detect drive spec by itself */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 && ! (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
1130 /* Detect unix format. */
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1131 #ifndef WIN32_NATIVE
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1132 && ! (IS_DIRECTORY_SEP (newdir[0]))
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1133 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 )
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 /* Effectively, let newdir be (expand-file-name newdir cwd).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 Because of the admonition against calling expand-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 when we have pointers into lisp strings, we accomplish this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 indirectly by prepending newdir to nm if necessary, and using
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 cwd (or the wd of newdir's drive) as the new newdir. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 drive = newdir[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 newdir += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 if (!IS_DIRECTORY_SEP (nm[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1149 Ibyte *tmp = alloca_ibytes (qxestrlen (newdir) +
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1150 qxestrlen (nm) + 2);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1151 file_name_as_directory (tmp, newdir);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1152 qxestrcat (tmp, nm);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 nm = tmp;
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 if (drive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 {
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1157 #ifdef WIN32_NATIVE
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1158 Ibyte *newcwd = mswindows_getdcwd (toupper (drive) - 'A' + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1159 if (newcwd)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1160 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1161 IBYTE_STRING_TO_ALLOCA (newcwd, newdir);
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1333
diff changeset
1162 xfree (newcwd, Ibyte *);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1163 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1164 else
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1165 #endif
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1166 IBYTE_STRING_TO_ALLOCA ((Ibyte *) "/", newdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 else
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1169 IBYTE_STRING_TO_ALLOCA (get_initial_directory (0, 0), newdir);
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 /* Strip off drive name from prefix, if present. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 drive = newdir[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 newdir += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 /* Keep only a prefix from newdir if nm starts with slash
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1180 (//server/share for UNC, nothing otherwise). */
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1181 if (IS_DIRECTORY_SEP (nm[0])
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1182 #ifndef WIN32_NATIVE
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1183 && IS_DIRECTORY_SEP (nm[1])
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1184 #endif
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1185 && collapse_newdir)
428
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 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1189 /* !!#### Use ei API */
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1190 newdir = qxestrcpy (alloca_ibytes (qxestrlen (newdir) + 1),
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1191 newdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 p = newdir + 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 *p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 else
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1199 newdir = (Ibyte *) "";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1202 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 if (newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 /* Get rid of any slash at the end of newdir, unless newdir is
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1207 just / or // (an incomplete UNC name). */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1208 length = qxestrlen (newdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 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
1210 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1215 Ibyte *temp = alloca_ibytes (length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 memcpy (temp, newdir, length - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 temp[length - 1] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 newdir = temp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 tlen = length + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 tlen = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 /* Now concatenate the directory and name to new space in the stack frame */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1226 tlen += qxestrlen (nm) + 1;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1227 #ifdef WIN32_FILENAMES
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1228 /* Reserve space for drive specifier and escape prefix, since either
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1229 or both may need to be inserted. (The Microsoft x86 compiler
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 produces incorrect code if the following two lines are combined.) */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1231 target = alloca_ibytes (tlen + 4);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1232 target += 4;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1233 #else /* not WIN32_FILENAMES */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1234 target = alloca_ibytes (tlen);
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1235 #endif /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 *target = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 if (newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1241 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1242 #ifdef WIN32_FILENAMES
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1243 /* If newdir is effectively "C:/", then the drive letter will have
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1244 been stripped and newdir will be "/". Concatenating with an
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1245 absolute directory in nm produces "//", which will then be
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1246 incorrectly treated as a network share. Ignore newdir in
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1247 this case (keeping the drive letter). */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1248 if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1249 && newdir[1] == '\0'))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1250 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1251 qxestrcpy (target, newdir);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1252 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1254 file_name_as_directory (target, newdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1257 qxestrcat (target, nm);
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 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1261 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1262 appear. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 p = target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 o = target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 while (*p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 if (!IS_DIRECTORY_SEP (*p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 *o++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 else if (IS_DIRECTORY_SEP (p[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 && p[1] == '.'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 && (IS_DIRECTORY_SEP (p[2])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 || p[2] == 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 /* If "/." is the entire filename, keep the "/". Otherwise,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 just delete the whole "/.". */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 if (o == target && p[2] == '\0')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 *o++ = *p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 p += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 /* `/../' is the "superroot" on certain file systems. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 && o != target
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 /* Keep initial / only if this is the whole name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 ++o;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 p += 3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1296 else if (p > target
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1297 && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1298 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1299 /* Collapse multiple `/' in a row. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1300 *o++ = *p++;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1301 while (IS_DIRECTORY_SEP (*p))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1302 ++p;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1303 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 *o++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1310 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 /* At last, set drive name, except for network file name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 if (drive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 target -= 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 target[0] = DRIVE_LETTER (drive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 target[1] = ':';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1318 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1323 #endif
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1324 /* Reinsert the escape prefix if required. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1325 if (is_escaped)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1326 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1327 target -= 2;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1328 target[0] = '/';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1329 target[1] = ':';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1330 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1331
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1332 *o = '\0';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1333
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1334 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1335 Ibyte *newtarget = mswindows_canonicalize_filename (target);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1336 Lisp_Object result = build_intstring (newtarget);
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1333
diff changeset
1337 xfree (newtarget, Ibyte *);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1338
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
1339 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, result);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1340 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1341 #else /* not WIN32_FILENAMES */
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
1342 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name,
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
1343 make_string (target, o - target));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1344 #endif /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1348 Return the canonical name of FILENAME.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1349 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
1350 (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
1351 the current buffer's value of `default-directory' is used.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 No component of the resulting pathname will be a symbolic link, as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 in the realpath() function.
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 (filename, default_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1357 /* This function can GC. GC checked 2000-07-28 ben. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 Lisp_Object expanded_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 struct gcpro gcpro1;
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 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 expanded_name = Fexpand_file_name (filename, default_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 if (!STRINGP (expanded_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 GCPRO1 (expanded_name);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1369
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1370 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1371 Lisp_Object handler =
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1372 Ffind_file_name_handler (expanded_name, Qfile_truename);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1373
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1374 if (!NILP (handler))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1375 RETURN_UNGCPRO
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1376 (call2_check_string (handler, Qfile_truename, expanded_name));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1377 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 {
2421
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1380 Ibyte resolved_path[PATH_MAX_INTERNAL];
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1381 Bytecount elen = XSTRING_LENGTH (expanded_name);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1382 Ibyte *path;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1383 Ibyte *p;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1384
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1385 LISP_STRING_TO_ALLOCA (expanded_name, path);
988
5df795348f45 [xemacs-hg @ 2002-09-01 22:13:52 by andyp]
andyp
parents: 872
diff changeset
1386
1111
184461bc8de4 [xemacs-hg @ 2002-11-18 06:52:23 by ben]
ben
parents: 996
diff changeset
1387 #if defined (WIN32_FILENAMES) && defined (CYGWIN)
988
5df795348f45 [xemacs-hg @ 2002-09-01 22:13:52 by andyp]
andyp
parents: 872
diff changeset
1388 /* When using win32 filenames in cygwin we want file-truename to
5df795348f45 [xemacs-hg @ 2002-09-01 22:13:52 by andyp]
andyp
parents: 872
diff changeset
1389 detect that c:/windows == /windows for example. */
1111
184461bc8de4 [xemacs-hg @ 2002-11-18 06:52:23 by ben]
ben
parents: 996
diff changeset
1390 if (! (IS_DIRECTORY_SEP (path[0]) && IS_DIRECTORY_SEP (path[1])))
184461bc8de4 [xemacs-hg @ 2002-11-18 06:52:23 by ben]
ben
parents: 996
diff changeset
1391 {
184461bc8de4 [xemacs-hg @ 2002-11-18 06:52:23 by ben]
ben
parents: 996
diff changeset
1392 LOCAL_TO_WIN32_FILE_FORMAT (path, p);
184461bc8de4 [xemacs-hg @ 2002-11-18 06:52:23 by ben]
ben
parents: 996
diff changeset
1393 path = p;
184461bc8de4 [xemacs-hg @ 2002-11-18 06:52:23 by ben]
ben
parents: 996
diff changeset
1394 }
988
5df795348f45 [xemacs-hg @ 2002-09-01 22:13:52 by andyp]
andyp
parents: 872
diff changeset
1395 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 p = path;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1397
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 /* Try doing it all at once. */
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
1399 if (!qxe_realpath (path, resolved_path, 0))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 /* 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
1402 /* "realpath" is a typically useless, stupid un*x piece of crap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 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
1404 there is no indication provided of how far along the pathname
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 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
1406 partial result returned. What a piece of junk.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1407
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1408 The above comment refers to historical versions of
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1409 realpath(). The Unix98 specs state:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1410
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1411 "On successful completion, realpath() returns a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1412 pointer to the resolved name. Otherwise, realpath()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1413 returns a null pointer and sets errno to indicate the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1414 error, and the contents of the buffer pointed to by
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1415 resolved_name are undefined."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1416
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1417 Since we depend on undocumented semantics of various system
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
1418 realpath()s, we just use our own version in realpath.c.
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
1419
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
1420 Note also that our own version differs in its semantics from any
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
1421 standard version, since it accepts and returns internal-format
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
1422 text, not external-format. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1425 Ibyte *pos;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1426
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1427 #ifdef WIN32_FILENAMES
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1428 if (IS_DRIVE (p[0]) && IS_DEVICE_SEP (p[1])
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1429 && IS_DIRECTORY_SEP (p[2]))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1430 /* don't test c: on windows */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1431 p = p+2;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1432 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
1433 /* start after // */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1434 p = p+1;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1435 #endif
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1436 for (pos = p + 1; pos < path + elen; pos++)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1437 if (IS_DIRECTORY_SEP (*pos))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1438 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1439 *(p = pos) = 0;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1440 break;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1441 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1442 if (p != pos)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1443 p = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
1445 if (qxe_realpath (path, resolved_path, 0))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 if (p)
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1448 *p = DIRECTORY_SEP;
428
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 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 else if (errno == ENOENT || errno == EACCES)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 /* Failed on this component. Just tack on the rest of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 the string and we are done. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1457 int rlen = qxestrlen (resolved_path);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 /* "On failure, it returns NULL, sets errno to indicate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 the error, and places in resolved_path the absolute pathname
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 of the path component which could not be resolved." */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1462
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1463 if (p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 int plen = elen - (p - path);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1467 if (rlen > 1 && IS_DIRECTORY_SEP (resolved_path[rlen - 1]))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 rlen = rlen - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 if (plen + rlen + 1 > countof (resolved_path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 goto toolong;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1473 resolved_path[rlen] = DIRECTORY_SEP;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
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 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1484 Lisp_Object resolved_name;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1485 int rlen = qxestrlen (resolved_path);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1486 if (elen > 0 && IS_DIRECTORY_SEP (string_byte (expanded_name, elen - 1))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1487 && !(rlen > 0 && IS_DIRECTORY_SEP (resolved_path[rlen - 1])))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 if (rlen + 1 > countof (resolved_path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 goto toolong;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1491 resolved_path[rlen++] = DIRECTORY_SEP;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1492 resolved_path[rlen] = '\0';
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1494 resolved_name = make_string (resolved_path, rlen);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1495 RETURN_UNGCPRO (resolved_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 toolong:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 errno = ENAMETOOLONG;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 lose:
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1502 report_file_error ("Finding truename", expanded_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1504 RETURN_UNGCPRO (Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 Substitute environment variables referred to in FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 `$FOO' where FOO is an environment variable name means to substitute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 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
1512 with a character, not a letter, digit or underscore; otherwise, enclose
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 the entire variable name in braces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 If `/~' appears, all of FILENAME through that `/' is discarded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1516 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1518 /* This function can GC. GC checked 2000-07-28 ben. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1519 Ibyte *nm;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1520
4324
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1521 Ibyte *s, *p, *o, *x, *endp, *got;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1522 Ibyte *target = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 int total = 0;
4324
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1524 int substituted = 0, seen_braces;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1525 Ibyte *xnm;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1528 CHECK_STRING (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1532 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 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
1535 filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1536
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1537 nm = XSTRING_DATA (filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1538 endp = nm + XSTRING_LENGTH (filename);
428
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 /* If /~ or // appears, discard everything through first slash. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 for (p = nm; p != endp; p++)
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 if ((p[0] == '~'
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1545 #if defined (WIN32_FILENAMES)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
1546 /* // at start of file name is meaningful in WindowsNT systems */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 || (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
1548 #else /* not (WIN32_FILENAMES) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 || IS_DIRECTORY_SEP (p[0])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1550 #endif /* not (WIN32_FILENAMES) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 && p != nm
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 && (IS_DIRECTORY_SEP (p[-1])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 nm = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 substituted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1558 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 /* see comment in expand-file-name about drive specifiers */
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 nm = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 substituted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1566 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 /* See if any variables are substituted into the string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 and find the total length of their values in `total' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 for (p = nm; p != endp;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 if (*p != '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 if (p == endp)
4324
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1579 {
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1580 /* No substitution, no error. */
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1581 break;
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1582 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 else if (*p == '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 /* "$$" means a single "$" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 total -= 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 substituted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 else if (*p == '{')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 o = ++p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 while (p != endp && *p != '}') p++;
4324
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1595 if (*p != '}')
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1596 {
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1597 /* No substitution, no error. Keep looking. */
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1598 p = o;
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1599 continue;
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1600 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 s = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 o = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 while (p != endp && (isalnum (*p) || *p == '_')) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 s = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 /* Copy out the variable name */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1611 target = alloca_ibytes (s - o + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1612 qxestrncpy (target, o, s - o);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 target[s - o] = 0;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1614 #ifdef WIN32_NATIVE
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1615 qxestrupr (target); /* $home == $HOME etc. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1616 #endif /* WIN32_NATIVE */
428
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 /* Get variable value */
4324
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1619 got = egetenv ((CIbyte *) target);
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1620 if (got)
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1621 {
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1622 total += qxestrlen (got);
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1623 substituted = 1;
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1624 }
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 if (!substituted)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1628 return filename;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1629
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1630 /* If substitution required, recopy the filename and do it */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 /* Make space in stack frame for the new copy */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1632 xnm = alloca_ibytes (XSTRING_LENGTH (filename) + total + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 x = xnm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 /* Copy the rest of the name through, replacing $ constructs with values */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 for (p = nm; *p;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 if (*p != '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 *x++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 else
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 p++;
4324
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1642 seen_braces = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 if (p == endp)
4324
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1644 {
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1645 *x++ = '$';
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1646 break;
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1647 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 else if (*p == '$')
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 *x++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 continue;
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 else if (*p == '{')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 {
4324
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1655 seen_braces = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 o = ++p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 while (p != endp && *p != '}') p++;
4324
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1658 if (*p != '}')
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1659 {
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1660 /* Don't syntax error, don't substitute */
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1661 *x++ = '{';
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1662 p = o;
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1663 continue;
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1664 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 s = p++;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 o = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 while (p != endp && (isalnum (*p) || *p == '_')) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 s = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 /* Copy out the variable name */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1675 target = alloca_ibytes (s - o + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1676 qxestrncpy (target, o, s - o);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 target[s - o] = 0;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1678 #ifdef WIN32_NATIVE
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1679 qxestrupr (target); /* $home == $HOME etc. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1680 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 /* Get variable value */
4324
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1683 got = egetenv ((CIbyte *) target);
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1684 if (got)
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1685 {
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1686 qxestrcpy (x, got);
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1687 x += qxestrlen (got);
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1688 }
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1689 else
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1690 {
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1691 *x++ = '$';
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1692 if (seen_braces)
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1693 {
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1694 *x++ = '{';
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1695 /* Preserve the original case. */
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1696 qxestrncpy (x, o, s - o);
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1697 x += s - o;
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1698 *x++ = '}';
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1699 }
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1700 else
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1701 {
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1702 /* Preserve the original case. */
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1703 qxestrncpy (x, o, s - o);
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1704 x += s - o;
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1705 }
5e526366d533 Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
1706 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 *x = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 /* If /~ or // appears, discard everything through first slash. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 for (p = xnm; p != x; p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 if ((p[0] == '~'
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1715 #if defined (WIN32_FILENAMES)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 || (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
1717 #else /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 || IS_DIRECTORY_SEP (p[0])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1719 #endif /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 /* 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
1722 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 xnm = p;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1724 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 else if (IS_DRIVE (p[0]) && p[1] == ':'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 && p > nm && IS_DIRECTORY_SEP (p[-1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 xnm = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 return make_string (xnm, x - xnm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 /* A slightly faster and more convenient way to get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 (directory-file-name (expand-file-name FOO)). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1739 /* This function can call Lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 abspath = Fexpand_file_name (filename, defdir);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 /* Remove final slash, if any (unless path is root).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 stat behaves differently depending! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 if (XSTRING_LENGTH (abspath) > 1
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1748 && IS_DIRECTORY_SEP (string_byte (abspath, XSTRING_LENGTH (abspath) - 1))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1749 && !IS_DEVICE_SEP (string_byte (abspath, XSTRING_LENGTH (abspath) - 2)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 /* We cannot take shortcuts; they might be wrong for magic file names. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 abspath = Fdirectory_file_name (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 return abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 /* Signal an error if the file ABSNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 If INTERACTIVE is nonzero, ask the user whether to proceed,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 and bypass the error if the user says to go ahead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 QUERYSTRING is a name for the action that is being considered
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 to alter the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 *STATPTR is used to store the stat information if the file exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 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
1763
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 static void
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
1765 barf_or_query_if_file_exists (Lisp_Object absname, const CIbyte *querystring,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 int interactive, struct stat *statptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1768 /* This function can call Lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 struct stat statbuf;
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 /* stat is a good way to tell whether the file exists,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 regardless of what access permissions it has. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1773 if (qxe_stat (XSTRING_DATA (absname), &statbuf) >= 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 if (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 Lisp_Object prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1782 prompt =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1783 emacs_sprintf_string
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1784 (CGETTEXT ("File %s already exists; %s anyway? "),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1785 XSTRING_DATA (absname), CGETTEXT (querystring));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 GCPRO1 (prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 tem = call1 (Qyes_or_no_p, prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 tem = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 if (NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 Fsignal (Qfile_already_exists,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1796 list2 (build_msg_string ("File already exists"),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 absname));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 if (statptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 *statptr = statbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 else
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 if (statptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 statptr->st_mode = 0;
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 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 DEFUN ("copy-file", Fcopy_file, 2, 4,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 "fCopy file: \nFCopy %s to file: \np\nP", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1811 Copy FILENAME to NEWNAME. Both args must be strings.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 Signals a `file-already-exists' error if file NEWNAME already exists,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 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
1814 A number as third arg means request confirmation if NEWNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 This is what happens in interactive use with M-x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 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
1817 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
1818 A prefix arg makes KEEP-TIME non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 (filename, newname, ok_if_already_exists, keep_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1822 /* This function can call Lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 int ifd, ofd, n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 char buf[16 * 1024];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 struct stat st, out_st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 /* Lisp_Object args[6]; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 int input_file_statable_p;
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 GCPRO2 (filename, newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 CHECK_STRING (newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 newname = Fexpand_file_name (newname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 /* If the input file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 handler = Ffind_file_name_handler (filename, Qcopy_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 /* Likewise for output file name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 handler = Ffind_file_name_handler (newname, Qcopy_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 if (!NILP (handler))
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 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 return call5 (handler, Qcopy_file, filename, newname,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 ok_if_already_exists, keep_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 /* When second argument is a directory, copy the file into it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
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 if (!NILP (Ffile_directory_p (newname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 Lisp_Object args[3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 int i = 1;
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 args[0] = newname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 args[1] = Qnil; args[2] = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 NGCPRO1 (*args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 ngcpro1.nvars = 3;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1864 if (!IS_DIRECTORY_SEP (string_byte (newname,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1865 XSTRING_LENGTH (newname) - 1)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1866
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1867 args[i++] = Fchar_to_string (Vdirectory_sep_char);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 args[i++] = Ffile_name_nondirectory (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 newname = Fconcat (i, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 NUNGCPRO;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 barf_or_query_if_file_exists (newname, "copy to it",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 INTP (ok_if_already_exists), &out_st);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1877 else if (qxe_stat (XSTRING_DATA (newname), &out_st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 out_st.st_mode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1880 ifd = qxe_interruptible_open (XSTRING_DATA (filename),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1881 O_RDONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 if (ifd < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1883 report_file_error ("Opening input file", filename);
428
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 record_unwind_protect (close_file_unwind, make_int (ifd));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 /* 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
1888 copyable by us. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1889 input_file_statable_p = (qxe_fstat (ifd, &st) >= 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1891 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 if (out_st.st_mode != 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 && 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
1894 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 errno = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 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
1897 list3 (Qunbound, filename, newname));
428
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 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 #if defined (S_ISREG) && defined (S_ISLNK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 if (input_file_statable_p)
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 if (!(S_ISREG (st.st_mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 #ifdef S_ISCHR
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 && !(S_ISCHR (st.st_mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 && !(S_ISLNK (st.st_mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 #if defined (EISDIR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 /* Get a better looking error message. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 errno = EISDIR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 #endif /* EISDIR */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1915 report_file_error ("Non-regular file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 #endif /* S_ISREG && S_ISLNK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1920 ofd = qxe_open (XSTRING_DATA (newname),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1921 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 if (ofd < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1923 report_file_error ("Opening output file", newname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 record_unwind_protect (close_file_unwind, ofd_locative);
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 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 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
1933 report_file_error ("I/O error", newname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 }
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 /* Closing the output clobbers the file times on some systems. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1937 if (retry_close (ofd) < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1938 report_file_error ("I/O error", newname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 if (input_file_statable_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1942 if (!NILP (keep_time))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1943 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1944 EMACS_TIME atime, mtime;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1945 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1946 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
1947 if (set_file_times (newname, atime, mtime))
4f6ba8f1fb3d [xemacs-hg @ 2001-05-31 12:03:37 by adrian]
adrian
parents: 563
diff changeset
1948 report_file_error ("I/O error", list1 (newname));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1949 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1950 qxe_chmod (XSTRING_DATA (newname), st.st_mode & 07777);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 /* We'll close it by hand */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 XCAR (ofd_locative) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 /* Close ifd */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1957 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 Create a directory. One argument, a file name string.
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 (dirname_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 struct gcpro gcpro1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1972 DECLARE_EISTRING (dir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 CHECK_STRING (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 dirname_ = Fexpand_file_name (dirname_, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 GCPRO1 (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 return (call2 (handler, Qmake_directory_internal, dirname_));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1983 eicpy_lstr (dir, dirname_);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1984 if (eigetch_char (dir, eicharlen (dir) - 1) == '/')
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1985 eidel (dir, eilen (dir) - 1, -1, 1, -1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1986
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1987 if (qxe_mkdir (eidata (dir), 0777) != 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1988 report_file_error ("Creating directory", dirname_);
428
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 Delete a directory. One argument, a file name or directory name string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 (dirname_))
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 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 CHECK_STRING (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 GCPRO1 (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 dirname_ = Fexpand_file_name (dirname_, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 dirname_ = Fdirectory_file_name (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 return (call2 (handler, Qdelete_directory, dirname_));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2013 if (qxe_rmdir (XSTRING_DATA (dirname_)) != 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2014 report_file_error ("Removing directory", dirname_);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2020 Delete the file named FILENAME (a string).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2021 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
2022 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 GCPRO1 (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 handler = Ffind_file_name_handler (filename, Qdelete_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 return call2 (handler, Qdelete_file, filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2038 if (0 > qxe_unlink (XSTRING_DATA (filename)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2039 report_file_error ("Removing old name", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 static Lisp_Object
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
2044 internal_delete_file_1 (Lisp_Object UNUSED (ignore),
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
2045 Lisp_Object UNUSED (ignore2))
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 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 internal_delete_file (Lisp_Object filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 internal_delete_file_1, 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 ("rename-file", Frename_file, 2, 3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 "fRename file: \nFRename %s to file: \np", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2062 Rename FILENAME as NEWNAME. Both args must be strings.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2063 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
2064 Signals a `file-already-exists' error if a file NEWNAME already exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 A number as third arg means request confirmation if NEWNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 This is what happens in interactive use with M-x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 (filename, newname, ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 /* This function can GC. GC checked 1997.04.06. */
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, newname);
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 (newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 newname = Fexpand_file_name (newname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 handler = Ffind_file_name_handler (filename, Qrename_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 handler = Ffind_file_name_handler (newname, Qrename_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 return call4 (handler, Qrename_file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 filename, newname, 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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 /* When second argument is a directory, rename the file into it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 if (!NILP (Ffile_directory_p (newname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 Lisp_Object args[3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 int i = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 args[0] = newname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 args[1] = Qnil; args[2] = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104 NGCPRO1 (*args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 ngcpro1.nvars = 3;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2106 if (string_byte (newname, XSTRING_LENGTH (newname) - 1) != '/')
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 args[i++] = build_string ("/");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 args[i++] = Ffile_name_nondirectory (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 newname = Fconcat (i, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 barf_or_query_if_file_exists (newname, "rename to it",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 INTP (ok_if_already_exists), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2118 /* We have configure check for rename() and emulate using
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2119 link()/unlink() if necessary. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2120 if (0 > qxe_rename (XSTRING_DATA (filename), XSTRING_DATA (newname)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 if (errno == EXDEV)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 Fcopy_file (filename, newname,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 /* We have already prompted if it was an integer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 so don't have copy-file prompt again. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 (NILP (ok_if_already_exists) ? Qnil : Qt),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 Fdelete_file (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2133 report_file_error ("Renaming", list3 (Qunbound, filename, newname));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 "fAdd name to file: \nFName to add to %s: \np", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2142 Give FILENAME additional name NEWNAME. Both args must be strings.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 Signals a `file-already-exists' error if a file NEWNAME already exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 A number as third arg means request confirmation if NEWNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 This is what happens in interactive use with M-x.
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, newname, ok_if_already_exists))
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 can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 GCPRO2 (filename, newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 CHECK_STRING (newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 newname = Fexpand_file_name (newname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 newname, ok_if_already_exists));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 /* If the new name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 newname, ok_if_already_exists));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 barf_or_query_if_file_exists (newname, "make it a new name",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 INTP (ok_if_already_exists), 0);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2178 /* #### Emacs 20.6 contains an implementation of link() in w32.c.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2179 Need to port. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2180 #ifndef HAVE_LINK
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2181 signal_error_2 (Qunimplemented, "Adding new name", filename, newname);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2182 #else /* HAVE_LINK */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2183 qxe_unlink (XSTRING_DATA (newname));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2184 if (0 > qxe_link (XSTRING_DATA (filename), XSTRING_DATA (newname)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 report_file_error ("Adding new name",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2187 list3 (Qunbound, filename, newname));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2189 #endif /* HAVE_LINK */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 Signals a `file-already-exists' error if a file LINKNAME already exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 A number as third arg means request confirmation if LINKNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 This happens for interactive use with M-x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 (filename, linkname, ok_if_already_exists))
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 /* This function can GC. GC checked 1997.06.04. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2206 /* 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
2207 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 GCPRO2 (filename, linkname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 CHECK_STRING (linkname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 /* If the link target has a ~, we must expand it to get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 a truly valid file name. Otherwise, do not expand;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 we want to permit links to relative file names. */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2216 if (string_byte (filename, 0) == '~')
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 linkname = Fexpand_file_name (linkname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225 ok_if_already_exists));
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 /* If the new link name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 linkname, ok_if_already_exists));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2234 #ifdef HAVE_SYMLINK
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 barf_or_query_if_file_exists (linkname, "make it a link",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 INTP (ok_if_already_exists), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2240 qxe_unlink (XSTRING_DATA (linkname));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2241 if (0 > qxe_symlink (XSTRING_DATA (filename),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2242 XSTRING_DATA (linkname)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 report_file_error ("Making symbolic link",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2245 list3 (Qunbound, filename, linkname));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2247 #endif
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2248
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 return 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 #ifdef HPUX_NET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 Open a network connection to PATH using LOGIN as the login string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258 (path, login))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 int netresult;
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
2261 const Extbyte *path_ext;
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
2262 const Extbyte *login_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 CHECK_STRING (path);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 CHECK_STRING (login);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 /* netunam, being a strange-o system call only used once, is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 encapsulated. */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2269
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2270 LISP_STRING_TO_EXTERNAL (path, path_ext, Qfile_name);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2271 LISP_STRING_TO_EXTERNAL (login, login_ext, Qnative);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2272
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2273 netresult = netunam (path_ext, login_ext);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2274
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2275 return netresult == -1 ? Qnil : Qt;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 #endif /* HPUX_NET */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 Return t if file FILENAME specifies an absolute path name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 On Unix, this is a name starting with a `/' or a `~'.
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 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285 /* This function does not GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2286 Ibyte *ptr;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 ptr = XSTRING_DATA (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
2291 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294 ) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 /* Return nonzero if file FILENAME exists and can be executed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 static int
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2300 check_executable (Lisp_Object filename)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2302 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 struct stat st;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2304 if (qxe_stat (XSTRING_DATA (filename), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 return ((st.st_mode & S_IEXEC) != 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2307 #else /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 #ifdef HAVE_EACCESS
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2309 return qxe_eaccess (XSTRING_DATA (filename), X_OK) >= 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311 /* Access isn't quite right because it uses the real uid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 and we really want to test with the effective uid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 But Unix doesn't give us a right way to do it. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2314 return qxe_access (XSTRING_DATA (filename), X_OK) >= 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 #endif /* HAVE_EACCESS */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2316 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 /* Return nonzero if file FILENAME exists and can be written. */
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 static int
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2322 check_writable (const Ibyte *filename)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 {
3728
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2324 #if defined(WIN32_NATIVE) || defined(CYGWIN)
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2325 #ifdef CYGWIN
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2326 char filename_buffer[PATH_MAX];
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2327 #endif
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2328 // Since this has to work for a directory, we can't just call 'CreateFile'
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2329 PSECURITY_DESCRIPTOR pDesc; /* Must be freed with LocalFree */
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2330 /* these need not be freed, they point into pDesc */
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2331 PSID psidOwner;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2332 PSID psidGroup;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2333 PACL pDacl;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2334 PACL pSacl;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2335 /* end of insides of descriptor */
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2336 DWORD error;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2337 DWORD attributes;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2338 HANDLE tokenHandle;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2339 GENERIC_MAPPING genericMapping;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2340 DWORD accessMask;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2341 PRIVILEGE_SET PrivilegeSet;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2342 DWORD dwPrivSetSize = sizeof( PRIVILEGE_SET );
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2343 BOOL fAccessGranted = FALSE;
3781
a257e03c580e [xemacs-hg @ 2007-01-08 13:33:42 by vins]
vins
parents: 3728
diff changeset
2344 DWORD dwAccessAllowed;
a257e03c580e [xemacs-hg @ 2007-01-08 13:33:42 by vins]
vins
parents: 3728
diff changeset
2345 Extbyte *fnameext;
3728
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2346
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2347 #ifdef CYGWIN
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2348 cygwin_conv_to_full_win32_path(filename, filename_buffer);
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2349 filename = (Ibyte*)filename_buffer;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2350 #endif
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2351
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2352 C_STRING_TO_TSTR(filename, fnameext);
3781
a257e03c580e [xemacs-hg @ 2007-01-08 13:33:42 by vins]
vins
parents: 3728
diff changeset
2353
a257e03c580e [xemacs-hg @ 2007-01-08 13:33:42 by vins]
vins
parents: 3728
diff changeset
2354 // First check for a normal file with the old-style readonly bit
a257e03c580e [xemacs-hg @ 2007-01-08 13:33:42 by vins]
vins
parents: 3728
diff changeset
2355 attributes = qxeGetFileAttributes(fnameext);
a257e03c580e [xemacs-hg @ 2007-01-08 13:33:42 by vins]
vins
parents: 3728
diff changeset
2356 if (FILE_ATTRIBUTE_READONLY == (attributes & (FILE_ATTRIBUTE_DIRECTORY|FILE_ATTRIBUTE_READONLY)))
a257e03c580e [xemacs-hg @ 2007-01-08 13:33:42 by vins]
vins
parents: 3728
diff changeset
2357 return 0;
a257e03c580e [xemacs-hg @ 2007-01-08 13:33:42 by vins]
vins
parents: 3728
diff changeset
2358
3728
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2359 /* Win32 prototype lacks const. */
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2360 error = qxeGetNamedSecurityInfo(fnameext, SE_FILE_OBJECT,
3781
a257e03c580e [xemacs-hg @ 2007-01-08 13:33:42 by vins]
vins
parents: 3728
diff changeset
2361 DACL_SECURITY_INFORMATION|GROUP_SECURITY_INFORMATION|OWNER_SECURITY_INFORMATION,
a257e03c580e [xemacs-hg @ 2007-01-08 13:33:42 by vins]
vins
parents: 3728
diff changeset
2362 &psidOwner, &psidGroup, &pDacl, &pSacl, &pDesc);
3728
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2363 if(error != ERROR_SUCCESS) { // FAT?
3781
a257e03c580e [xemacs-hg @ 2007-01-08 13:33:42 by vins]
vins
parents: 3728
diff changeset
2364 attributes = qxeGetFileAttributes(fnameext);
3728
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2365 return (attributes & FILE_ATTRIBUTE_DIRECTORY) || (0 == (attributes & FILE_ATTRIBUTE_READONLY));
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2366 }
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2367
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2368 genericMapping.GenericRead = FILE_GENERIC_READ;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2369 genericMapping.GenericWrite = FILE_GENERIC_WRITE;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2370 genericMapping.GenericExecute = FILE_GENERIC_EXECUTE;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2371 genericMapping.GenericAll = FILE_ALL_ACCESS;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2372
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2373 if(!ImpersonateSelf(SecurityDelegation)) {
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2374 return 0;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2375 }
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2376 if(!OpenThreadToken(GetCurrentThread(), TOKEN_ALL_ACCESS, TRUE, &tokenHandle)) {
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2377 return 0;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2378 }
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2379
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2380 accessMask = GENERIC_WRITE;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2381 MapGenericMask(&accessMask, &genericMapping);
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2382
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2383 if(!AccessCheck(pDesc, tokenHandle, accessMask, &genericMapping,
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2384 &PrivilegeSet, // receives privileges used in check
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2385 &dwPrivSetSize, // size of PrivilegeSet buffer
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2386 &dwAccessAllowed, // receives mask of allowed access rights
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2387 &fAccessGranted))
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2388 {
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2389 CloseHandle(tokenHandle);
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2390 RevertToSelf();
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2391 LocalFree(pDesc);
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2392 return 0;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2393 }
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2394 CloseHandle(tokenHandle);
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2395 RevertToSelf();
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2396 LocalFree(pDesc);
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2397 return fAccessGranted == TRUE;
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2398 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 #ifdef HAVE_EACCESS
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2400 return (qxe_eaccess (filename, W_OK) >= 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 /* Access isn't quite right because it uses the real uid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 and we really want to test with the effective uid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 But Unix doesn't give us a right way to do it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 Opening with O_WRONLY could work for an ordinary file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 but would lose for directories. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2407 return (qxe_access (filename, W_OK) >= 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 #endif
3728
6765f2581182 [xemacs-hg @ 2006-12-08 02:21:53 by vins]
vins
parents: 3722
diff changeset
2409 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 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
2414 See also `file-readable-p' and `file-attributes'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2418 /* This function can call lisp; GC checked 2000-07-11 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2419 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2420 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2421 struct stat statbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 abspath = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 return call2 (handler, Qfile_exists_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2435 return qxe_stat (XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 Return t if FILENAME can be executed by you.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 For a directory, this means you can access files in that directory.
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 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2445 /* This function can GC. GC checked 07-11-2000 ben. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451 abspath = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456 handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 return call2 (handler, Qfile_executable_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2461 return check_executable (abspath) ? Qt : Qnil;
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 Return t if file FILENAME exists and you can read it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 See also `file-exists-p' and `file-attributes'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 Lisp_Object abspath = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 abspath = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2485 #if defined (WIN32_FILENAMES)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 /* Under MS-DOS and Windows, open does not work for directories. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487 UNGCPRO;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2488 if (qxe_access (XSTRING_DATA (abspath), 0) == 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 return Qnil;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
2492 #else /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2494 int desc = qxe_interruptible_open (XSTRING_DATA (abspath),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2495 O_RDONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 if (desc < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 return Qnil;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2499 retry_close (desc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
2502 #endif /* not WIN32_FILENAMES */
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 on the RT/PC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 Return t if file FILENAME can be written or created by you.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 Lisp_Object abspath, dir;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 struct stat statbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 abspath = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 return call2 (handler, Qfile_writable_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2529 if (qxe_stat (XSTRING_DATA (abspath), &statbuf) >= 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2530 return (check_writable (XSTRING_DATA (abspath))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 ? Qt : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535 dir = Ffile_name_directory (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 UNGCPRO;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2537 return (check_writable (!NILP (dir) ? XSTRING_DATA (dir) : (Ibyte *) "")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 ? Qt : Qnil);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 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
2543 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
2544 Otherwise returns nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2545 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 /* This function can GC. GC checked 1997.04.10. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2549 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2550 #ifdef HAVE_READLINK
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2551 Ibyte *buf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 int bufsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 int valsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554 Lisp_Object val;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2555 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2562 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 GCPRO1 (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2566 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2567 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568 return call2 (handler, Qfile_symlink_p, filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2570 #ifdef HAVE_READLINK
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2571 bufsize = 100;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2572 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2573 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2574 buf = xnew_array_and_zero (Ibyte, bufsize);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2575 valsize = qxe_readlink (XSTRING_DATA (filename),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2576 buf, bufsize);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577 if (valsize < bufsize) break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578 /* Buffer was not long enough */
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1333
diff changeset
2579 xfree (buf, Ibyte *);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580 bufsize *= 2;
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 if (valsize == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 {
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1333
diff changeset
2584 xfree (buf, Ibyte *);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2587 val = make_string (buf, valsize);
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1333
diff changeset
2588 xfree (buf, Ibyte *);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589 return val;
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2590 #elif defined (WIN32_NATIVE)
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2591 if (mswindows_shortcuts_are_symlinks)
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2592 {
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2593 /* We want to resolve the directory component and leave the rest
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2594 alone. */
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2595 Ibyte *path = XSTRING_DATA (filename);
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2596 Ibyte *dirend =
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2597 find_end_of_directory_component (path, XSTRING_LENGTH (filename));
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2598 Ibyte *fname;
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2599 DECLARE_EISTRING (dir);
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2600
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2601 if (dirend != path)
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2602 {
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2603 Ibyte *resdir;
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2604 DECLARE_EISTRING (resname);
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2605
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2606 eicpy_raw (dir, path, dirend - path);
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2607 PATHNAME_RESOLVE_LINKS (eidata (dir), resdir);
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2608 eicpy_rawz (resname, resdir);
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2609 eicat_rawz (resname, dirend);
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2610 path = eidata (resname);
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2611 }
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2612
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2613 fname = mswindows_read_link (path);
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2614 if (!fname)
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2615 return Qnil;
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2616 {
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2617 Lisp_Object val = build_intstring (fname);
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2618 xfree (fname, Ibyte *);
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2619 return val;
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2620 }
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2621 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2622 return Qnil;
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2623 #else
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2624 return Qnil;
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2625 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2626 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2628 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2629 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
2630 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
2631 if the directory so specified exists and really is a directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2632 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2633 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2634 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2635 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2636 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2637 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2638 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2639 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2641 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2642 abspath = expand_and_dir_to_file (filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2643 current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2644 UNGCPRO;
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 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2647 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649 handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2650 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 return call2 (handler, Qfile_directory_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2654 if (qxe_stat (XSTRING_DATA (abspath), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 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
2661 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
2662 directory as a buffer's current directory, this predicate must return true.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2663 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
2664 if the directory so specified exists and really is a readable and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 searchable directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2667 (filename))
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 GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676 return call2 (handler, Qfile_accessible_directory_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
2679 #if !defined (WIN32_NATIVE)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680 if (NILP (Ffile_directory_p (filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 return (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 return Ffile_executable_p (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 int tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2687 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2688 /* 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
2689 Suppose that file-accessible-directory-p has no handler, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2690 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
2691 relocates the string in `filename'; and finally file-directory-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 returns non-nil. Then we would end up passing a garbaged string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693 to file-executable-p. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 GCPRO1 (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695 tem = (NILP (Ffile_directory_p (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2696 || NILP (Ffile_executable_p (filename)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698 return tem ? Qnil : Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2700 #endif /* !defined(WIN32_NATIVE) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2702
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2703 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704 Return t if file FILENAME is the name of a regular file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705 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
2706 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2711 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2712 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2713 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2714
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2715 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2716 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2717 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2719 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2720 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2721 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2722 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2723 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2724 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2725 return call2 (handler, Qfile_regular_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2726
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2727 if (qxe_stat (XSTRING_DATA (abspath), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2728 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2729 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2733 Return mode bits of file named FILENAME, as an integer.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2734 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 (filename))
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 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2738 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2739 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2740 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741 struct gcpro gcpro1;
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 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2744 abspath = expand_and_dir_to_file (filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2745 current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2746 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2747
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2748 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2749 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2750 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751 handler = Ffind_file_name_handler (abspath, Qfile_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2752 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2753 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2754 return call2 (handler, Qfile_modes, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2756 if (qxe_stat (XSTRING_DATA (abspath), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2758 /* 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
2759 #if 0
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2760 #ifdef WIN32_NATIVE
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2761 if (check_executable (abspath))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2762 st.st_mode |= S_IEXEC;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2763 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2765
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 return make_int (st.st_mode & 07777);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2769 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2770 Set mode bits of file named FILENAME to MODE (an integer).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2771 Only the 12 low bits of MODE are used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2772 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773 (filename, mode))
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 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2778 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2779
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2780 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2781 abspath = Fexpand_file_name (filename, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2783
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784 CHECK_INT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2785
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2786 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2788 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2789 handler = Ffind_file_name_handler (abspath, Qset_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792 return call3 (handler, Qset_file_modes, abspath, mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2794 if (qxe_chmod (XSTRING_DATA (abspath), XINT (mode)) < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2795 report_file_error ("Doing chmod", abspath);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 Set the file permission bits for newly created files.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2802 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
2803 subsequently created files will not have the permission corresponding
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2804 to that bit enabled. Only the low 9 bits are used.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 This setting is inherited by subprocesses.
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 (mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2809 CHECK_INT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2810
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811 umask ((~ XINT (mode)) & 0777);
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814 }
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 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2817 Return the default file protection for created files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2818 The umask value determines which permissions are enabled in newly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819 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
2820 created files will not have that permission enabled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 int mode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2826 mode = umask (0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2827 umask (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829 return make_int ((~ mode) & 0777);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2831
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2832 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2833 Tell Unix to finish all pending disk updates.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2837 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838 sync ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2840 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2841 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2844 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
2845 Return t if file FILE1 is newer than file FILE2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2846 If FILE1 does not exist, the answer is nil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2847 otherwise, if FILE2 does not exist, the answer is t.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2848 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2849 (file1, file2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2850 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2851 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2852 Lisp_Object abspath1, abspath2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2853 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 int mtime1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2855 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2857
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858 CHECK_STRING (file1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859 CHECK_STRING (file2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2860
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861 abspath1 = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2862 abspath2 = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2863
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 GCPRO3 (abspath1, abspath2, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2865 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2866 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2867
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2868 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2869 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2870 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2871 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2872 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2873 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2874 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2875 return call3 (handler, Qfile_newer_than_file_p, abspath1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2876 abspath2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2877
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2878 if (qxe_stat (XSTRING_DATA (abspath1), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2879 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2880
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2881 mtime1 = st.st_mtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2882
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2883 if (qxe_stat (XSTRING_DATA (abspath2), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2884 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2885
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2886 return (mtime1 > st.st_mtime) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2887 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2888
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2889
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2890 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2891 /* #define READ_BUF_SIZE (2 << 16) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2892 #define READ_BUF_SIZE (1 << 15)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2893
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2894 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2895 1, 7, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2896 Insert contents of file FILENAME after point; no coding-system frobbing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2897 This function is identical to `insert-file-contents' except for the
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2898 handling of the CODESYS and USED-CODESYS arguments.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2899
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2900 The file is decoded according to CODESYS; if omitted, no conversion
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2901 happens. If USED-CODESYS is non-nil, it should be a symbol, and the actual
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2902 coding system that was used for the decoding is stored into it. It will in
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2903 general be different from CODESYS if CODESYS specifies automatic encoding
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2904 detection or end-of-line detection.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2905
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2906 Currently START and END refer to byte positions (as opposed to character
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2907 positions), even in Mule and under MS Windows. (Fixing this, particularly
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2908 under Mule, is very difficult.)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2909 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2910 (filename, visit, start, end, replace, codesys, used_codesys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2911 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2912 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2913 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2914 int fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2915 int saverrno = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2916 Charcount inserted = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2917 int speccount;
3841
5989b9bbb612 [xemacs-hg @ 2007-02-22 16:19:40 by stephent]
stephent
parents: 3814
diff changeset
2918 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3814
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
2919 Lisp_Object val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2920 int total;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2921 Ibyte read_buf[READ_BUF_SIZE];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 int mc_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 struct buffer *buf = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 Lisp_Object curbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2925 int not_regular = 0;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2926 int do_speedy_insert =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2927 coding_system_is_binary (Fget_coding_system (codesys));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2928
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2929 if (buf->base_buffer && ! NILP (visit))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2930 invalid_operation ("Cannot do file visiting in an indirect buffer", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2931
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2932 /* No need to call Fbarf_if_buffer_read_only() here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2933 That's called in begin_multiple_change() or wherever. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2934
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2935 val = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2936
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2937 /* #### dmoore - should probably check in various places to see if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2938 curbuf was killed and if so signal an error? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2939
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
2940 curbuf = wrap_buffer (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2941
3814
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
2942 GCPRO4 (filename, val, visit, curbuf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2944 mc_count = (NILP (replace)) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2945 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2946 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2947
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2948 speccount = specpdl_depth (); /* begin_multiple_change also adds
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2949 an unwind_protect */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2950
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2951 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2952
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2953 if (!NILP (used_codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2954 CHECK_SYMBOL (used_codesys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2955
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2956 if ( (!NILP (start) || !NILP (end)) && !NILP (visit) )
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2957 invalid_operation ("Attempt to visit less than an entire file", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2958
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2959 fd = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2960
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2961 if (qxe_stat (XSTRING_DATA (filename), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2962 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2963 badopen:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2964 if (NILP (visit))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2965 report_file_error ("Opening input file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2966 st.st_mtime = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2967 goto notfound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2968 }
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 #ifdef S_IFREG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2971 /* 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
2972 REPLACE, START or END being non-nil. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2973 if (!S_ISREG (st.st_mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2974 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 not_regular = 1;
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 if (!NILP (visit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2978 goto notfound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2980 if (!NILP (replace) || !NILP (start) || !NILP (end))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2981 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2982 end_multiple_change (buf, mc_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2983
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2984 RETURN_UNGCPRO
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2985 (Fsignal (Qfile_error,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2986 list2 (build_msg_string("not a regular file"),
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2987 filename)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2988 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 #endif /* S_IFREG */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2992 if (!NILP (start))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2993 CHECK_INT (start);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2995 start = Qzero;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2996
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997 if (!NILP (end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 CHECK_INT (end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2999
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3000 if (fd < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3001 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3002 if ((fd = qxe_interruptible_open (XSTRING_DATA (filename),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3003 O_RDONLY | OPEN_BINARY, 0)) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004 goto badopen;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3007 /* Replacement should preserve point as it preserves markers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3008 if (!NILP (replace))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3009 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011 record_unwind_protect (close_file_unwind, make_int (fd));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013 /* Supposedly happens on VMS. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014 if (st.st_size < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3015 signal_error (Qfile_error, "File size is negative", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 if (NILP (end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3018 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3019 if (!not_regular)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3020 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3021 end = make_int (st.st_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3022 if (XINT (end) != st.st_size)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3023 out_of_memory ("Maximum buffer size exceeded", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025 }
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 /* If requested, replace the accessible part of the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 with the file contents. Avoid replacing text at the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 beginning or end of the buffer that matches the file contents;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3030 that preserves markers pointing to the unchanged parts. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3031 /* The replace-mode code is currently implemented by comparing the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3032 file on disk with the contents in the buffer, character by character.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3033 That works only if the characters on disk are exactly what will go into
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3034 the buffer -- i.e. `binary' conversion.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3035
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3036 FSF tries to implement this in all situations, even the non-binary
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3037 conversion, by (in that case) loading the whole converted file into a
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3038 separate memory area, then doing the comparison. I really don't see
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3039 the point of this, and it will fail spectacularly if the file is many
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3040 megabytes in size. To try to get around this, we could certainly read
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3041 from the beginning and decode as necessary before comparing, but doing
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3042 the same at the end gets very difficult because of the possibility of
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3043 modal coding systems -- trying to decode data from any point forward
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3044 without decoding previous data might always give you different results
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3045 from starting at the beginning. We could try further tricks like
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3046 keeping track of which coding systems are non-modal and providing some
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3047 extra method for such coding systems to be given a chunk of data that
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3048 came from a specified location in a specified file and ask the coding
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3049 systems to return a "sync point" from which the data can be read
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3050 forward and have results guaranteed to be the same as reading from the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3051 beginning to that point, but I really don't think it's worth it. If
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3052 we implemented the FSF "brute-force" method, we would have to put a
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3053 reasonable maximum file size on the files. Is any of this worth it?
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3054 --ben
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3055
3638
305157cf3ebb [xemacs-hg @ 2006-10-27 19:07:32 by aidan]
aidan
parents: 3462
diff changeset
3056
305157cf3ebb [xemacs-hg @ 2006-10-27 19:07:32 by aidan]
aidan
parents: 3462
diff changeset
3057 It's probably not worth it, and despite what you might take from the
305157cf3ebb [xemacs-hg @ 2006-10-27 19:07:32 by aidan]
aidan
parents: 3462
diff changeset
3058 above, we don't do it currently; that is, for non-"binary" coding
305157cf3ebb [xemacs-hg @ 2006-10-27 19:07:32 by aidan]
aidan
parents: 3462
diff changeset
3059 systems, we don't try to implement replace-mode at all. See the
305157cf3ebb [xemacs-hg @ 2006-10-27 19:07:32 by aidan]
aidan
parents: 3462
diff changeset
3060 do_speedy_insert variable above. The upside of this is that our API
305157cf3ebb [xemacs-hg @ 2006-10-27 19:07:32 by aidan]
aidan
parents: 3462
diff changeset
3061 is consistent and not buggy. -- Aidan Kehoe, Fri Oct 27 21:02:30 CEST
305157cf3ebb [xemacs-hg @ 2006-10-27 19:07:32 by aidan]
aidan
parents: 3462
diff changeset
3062 2006
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3063 */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3064
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065 if (!NILP (replace))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3067 if (!do_speedy_insert)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3068 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3069 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3070 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3071 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3072 char buffer[1 << 14];
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3073 Charbpos same_at_start = BUF_BEGV (buf);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3074 Charbpos same_at_end = BUF_ZV (buf);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3075 int overlap;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3076
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3077 /* Count how many chars at the start of the file
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3078 match the text at the beginning of the buffer. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3079 while (1)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3080 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3081 int nread;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3082 Charbpos charbpos;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3083 nread = read_allowing_quit (fd, buffer, sizeof (buffer));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3084 if (nread < 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3085 report_file_error ("Reading", filename);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3086 else if (nread == 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3087 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3088 charbpos = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3089 while (charbpos < nread && same_at_start < BUF_ZV (buf)
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
3090 && BUF_FETCH_CHAR (buf, same_at_start) ==
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
3091 buffer[charbpos])
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3092 same_at_start++, charbpos++;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3093 /* If we found a discrepancy, stop the scan.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3094 Otherwise loop around and scan the next bufferful. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3095 if (charbpos != nread)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3096 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3097 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3098 /* If the file matches the buffer completely,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3099 there's no need to replace anything. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3100 if (same_at_start - BUF_BEGV (buf) == st.st_size)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3101 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3102 retry_close (fd);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3103 unbind_to (speccount);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3104 /* Truncate the buffer to the size of the file. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3105 buffer_delete_range (buf, same_at_start, same_at_end,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3106 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3107 goto handled;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3108 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3109 /* Count how many chars at the end of the file
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3110 match the text at the end of the buffer. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3111 while (1)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3112 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3113 int total_read, nread;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
3114 Charcount charbpos, curpos, trial;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3115
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3116 /* At what file position are we now scanning? */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3117 curpos = st.st_size - (BUF_ZV (buf) - same_at_end);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3118 /* If the entire file matches the buffer tail, stop the scan. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3119 if (curpos == 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3120 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3121 /* How much can we scan in the next step? */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3122 trial = min (curpos, (Charbpos) sizeof (buffer));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3123 if (lseek (fd, curpos - trial, 0) < 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3124 report_file_error ("Setting file position", filename);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3125
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3126 total_read = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3127 while (total_read < trial)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3128 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3129 nread = read_allowing_quit (fd, buffer + total_read,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3130 trial - total_read);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3131 if (nread <= 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3132 report_file_error ("IO error reading file", filename);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3133 total_read += nread;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3134 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3135 /* Scan this bufferful from the end, comparing with
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3136 the Emacs buffer. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3137 charbpos = total_read;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3138 /* Compare with same_at_start to avoid counting some buffer text
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3139 as matching both at the file's beginning and at the end. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3140 while (charbpos > 0 && same_at_end > same_at_start
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3141 && BUF_FETCH_CHAR (buf, same_at_end - 1) ==
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3142 buffer[charbpos - 1])
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3143 same_at_end--, charbpos--;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3144 /* If we found a discrepancy, stop the scan.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3145 Otherwise loop around and scan the preceding bufferful. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3146 if (charbpos != 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3147 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3148 /* If display current starts at beginning of line,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3149 keep it that way. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3150 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3151 XWINDOW (Fselected_window (Qnil))->start_at_line_beg =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3152 !NILP (Fbolp (wrap_buffer (buf)));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3153 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3154
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3155 /* Don't try to reuse the same piece of text twice. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3156 overlap = same_at_start - BUF_BEGV (buf) -
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3157 (same_at_end + st.st_size - BUF_ZV (buf));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3158 if (overlap > 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3159 same_at_end += overlap;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3160
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3161 /* Arrange to read only the nonmatching middle part of the file. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3162 start = make_int (same_at_start - BUF_BEGV (buf));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3163 end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3164
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165 buffer_delete_range (buf, same_at_start, same_at_end,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3167 /* Insert from the file at the proper position. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3168 BUF_SET_PT (buf, same_at_start);
428
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172 if (!not_regular)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3174 total = XINT (end) - XINT (start);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 /* Make sure point-max won't overflow after this insertion. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 if (total != XINT (make_int (total)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3178 out_of_memory ("Maximum buffer size exceeded", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3181 /* 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
3182 will make the stream functions read as much as possible. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3183 total = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3184
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3185 if (XINT (start) != 0
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3186 /* 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
3187 connivings above will normally put the file pointer other than
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188 where it should be. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3189 || (!NILP (replace) && do_speedy_insert))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3190 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3191 if (lseek (fd, XINT (start), 0) < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3192 report_file_error ("Setting file position", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3193 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
3196 Charbpos cur_point = BUF_PT (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199 LSTR_ALLOW_QUIT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3201 NGCPRO1 (stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3202 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3203 stream = make_coding_input_stream
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3204 (XLSTREAM (stream), get_coding_system_for_text_file (codesys, 1),
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
3205 CODING_DECODE, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3206 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208 record_unwind_protect (delete_stream_unwind, stream);
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 /* 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
3211 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3212 occurs inside of the filedesc stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3213 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3214 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
3215 Bytecount this_len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 Charcount cc_inserted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3219 this_len = Lstream_read (XLSTREAM (stream), read_buf,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3220 sizeof (read_buf));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3222 if (this_len <= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3224 if (this_len < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3225 saverrno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229 cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230 this_len,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231 !NILP (visit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232 ? INSDEL_NO_LOCKING : 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233 inserted += cc_inserted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 cur_point += cc_inserted;
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 if (!NILP (used_codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 Fset (used_codesys,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3239 XCODING_SYSTEM_NAME
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3240 (coding_stream_detected_coding_system (XLSTREAM (stream))));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3242 NUNGCPRO;
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 /* Close the file/stream */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3246 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 if (saverrno != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3250 errno = saverrno;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3251 report_file_error ("Reading", filename);
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3254 notfound:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3255 handled:
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 end_multiple_change (buf, mc_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3259 if (!NILP (visit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3261 if (!EQ (buf->undo_list, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3262 buf->undo_list = Qnil;
3814
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
3263 buf->modtime = st.st_mtime;
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
3264 buf->filename = filename;
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
3265 /* XEmacs addition: */
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
3266 /* This function used to be in C, ostensibly so that
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
3267 it could be called here. But that's just silly.
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
3268 There's no reason C code can't call out to Lisp
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
3269 code, and it's a lot cleaner this way. */
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
3270 /* Note: compute-buffer-file-truename is called for
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
3271 side-effect! Its return value is intentionally
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
3272 ignored. */
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
3273 if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
3274 call1 (Qcompute_buffer_file_truename, wrap_buffer (buf));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3276 buf->auto_save_modified = BUF_MODIFF (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3277 buf->saved_size = make_int (BUF_SIZE (buf));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3278 #ifdef CLASH_DETECTION
3814
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
3279 if (!NILP (buf->file_truename))
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
3280 unlock_file (buf->file_truename);
b98f0084dc23 [xemacs-hg @ 2007-02-05 15:33:17 by michaels]
michaels
parents: 3781
diff changeset
3281 unlock_file (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3282 #endif /* CLASH_DETECTION */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3283 if (not_regular)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3284 RETURN_UNGCPRO (Fsignal (Qfile_error,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3285 list2 (build_msg_string ("not a regular file"),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3286 filename)));
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 /* If visiting nonexistent file, return nil. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3289 if (buf->modtime == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3290 report_file_error ("Opening input file",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3291 filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3292 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3293
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3294 /* Decode file format */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3295 if (inserted > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3296 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3297 Lisp_Object insval = call3 (Qformat_decode,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3298 Qnil, make_int (inserted), visit);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3299 CHECK_INT (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3300 inserted = XINT (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3301 }
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 if (inserted > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3304 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
3305 GC_EXTERNAL_LIST_LOOP_2 (p, Vafter_insert_file_functions)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3306 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
3307 Lisp_Object insval = call1 (p, make_int (inserted));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3308 if (!NILP (insval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3309 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3310 CHECK_NATNUM (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3311 inserted = XINT (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3312 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3313 }
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
3314 END_GC_EXTERNAL_LIST_LOOP (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3315 }
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 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3319 if (!NILP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3320 return (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3321 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3322 return (list2 (filename, make_int (inserted)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3323 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3325
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3326 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3327 Lisp_Object *annot);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3328 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3329
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3330 /* If build_annotations switched buffers, switch back to BUF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3331 Kill the temporary buffer that was selected in the meantime. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3332
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3333 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3334 build_annotations_unwind (Lisp_Object buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3335 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3336 Lisp_Object tembuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3338 if (XBUFFER (buf) == current_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3339 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3340 tembuf = Fcurrent_buffer ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3341 Fset_buffer (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3342 Fkill_buffer (tembuf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3343 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3344 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3345
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3346 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 8,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3347 "r\nFWrite region to file: ", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3348 Write current region into specified file; no coding-system frobbing.
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3349
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3350 This function is almost identical to `write-region'; see that function for
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3351 documentation of the START, END, FILENAME, APPEND, VISIT, and LOCKNAME
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3352 arguments. CODESYS specifies the encoding to be used for the file; if it is
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3353 nil, no code conversion occurs. (With `write-region' the coding system is
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3354 determined automatically if not specified.)
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3355
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3356 MUSTBENEW specifies that a check for an existing file of the same name
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3357 should be made. If it is 'excl, XEmacs will error on detecting such a file
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3358 and never write it. If it is some other non-nil value, the user will be
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3359 prompted to confirm the overwriting of an existing file. If it is nil,
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3360 existing files are silently overwritten when file system permissions allow
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3361 this.
764
3c5d0bca9200 [xemacs-hg @ 2002-03-05 13:00:37 by stephent]
stephent
parents: 751
diff changeset
3362
3c5d0bca9200 [xemacs-hg @ 2002-03-05 13:00:37 by stephent]
stephent
parents: 751
diff changeset
3363 As a special kludge to support auto-saving, when START is nil START and
3c5d0bca9200 [xemacs-hg @ 2002-03-05 13:00:37 by stephent]
stephent
parents: 751
diff changeset
3364 END are set to the beginning and end, respectively, of the buffer,
3c5d0bca9200 [xemacs-hg @ 2002-03-05 13:00:37 by stephent]
stephent
parents: 751
diff changeset
3365 regardless of any restrictions. Don't use this feature. It is documented
3c5d0bca9200 [xemacs-hg @ 2002-03-05 13:00:37 by stephent]
stephent
parents: 751
diff changeset
3366 here because write-region handler writers need to be aware of it.
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3367
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3368 */
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3369 (start, end, filename, append, visit, lockname, codesys,
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3370 mustbenew))
428
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 /* This function can call lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3373 int desc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3374 int failure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3375 int save_errno = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3376 struct stat st;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3377 Lisp_Object fn = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3378 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3379 int visiting_other = STRINGP (visit);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3380 int visiting = (EQ (visit, Qt) || visiting_other);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3381 int quietly = (!visiting && !NILP (visit));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3382 Lisp_Object visit_file = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3383 Lisp_Object annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3384 struct buffer *given_buffer;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
3385 Charbpos start1, end1;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3386 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3387 struct gcpro ngcpro1, ngcpro2;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3388 Lisp_Object curbuf = wrap_buffer (current_buffer);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3389
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3390
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3391 /* start, end, visit, and append are never modified in this fun
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3392 so we don't protect them. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3393 GCPRO5 (visit_file, filename, codesys, lockname, annotations);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3394 NGCPRO2 (curbuf, fn);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3395
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3396 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3397 we should signal an error rather than blissfully continuing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3398 along. ARGH, this function is going to lose lose lose. We need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3399 to protect the current_buffer from being destroyed, but the
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3400 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
3401 protect curbuf now. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3402
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3403 codesys = get_coding_system_for_text_file (codesys, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3405 if (current_buffer->base_buffer && ! NILP (visit))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3406 invalid_operation ("Cannot do file visiting in an indirect buffer",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3407 curbuf);
428
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 if (!NILP (start) && !STRINGP (start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3410 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3412 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3413 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3414
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3415 if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3416 barf_or_query_if_file_exists (filename, "overwrite", 1, NULL);
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3417
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3418 if (visiting_other)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3419 visit_file = Fexpand_file_name (visit, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3420 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3421 visit_file = filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3422 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3424 if (NILP (lockname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3425 lockname = visit_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3426
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3427 /* 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
3428 more Lisp calling. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3429 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3430 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3431 handler = Ffind_file_name_handler (filename, Qwrite_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3432 /* If FILENAME has no handler, see if VISIT has one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3433 if (NILP (handler) && STRINGP (visit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3434 handler = Ffind_file_name_handler (visit, Qwrite_region);
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 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3437 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3438 Lisp_Object val = call8 (handler, Qwrite_region, start, end,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3439 filename, append, visit, lockname, codesys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3440 if (visiting)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3441 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3442 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3443 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3444 current_buffer->filename = visit_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3445 MARK_MODELINE_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3446 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3447 NUNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3448 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3449 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3450 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3453 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3454 if (!auto_saving)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3455 lock_file (lockname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3456 #endif /* CLASH_DETECTION */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3457
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3458 /* Special kludge to simplify auto-saving. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3459 if (NILP (start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3460 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3461 start1 = BUF_BEG (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3462 end1 = BUF_Z (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3463 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3465 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3466
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3467 given_buffer = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3468 annotations = build_annotations (start, end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3469 if (current_buffer != given_buffer)
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 start1 = BUF_BEGV (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3472 end1 = BUF_ZV (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3473 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3475 fn = filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3476 desc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3477 if (!NILP (append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3478 {
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3479 desc = qxe_open (XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3480 | (EQ (mustbenew, Qexcl) ? O_EXCL : 0), 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3481 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3482 if (desc < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3483 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3484 desc = qxe_open (XSTRING_DATA (fn),
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3485 O_WRONLY | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC)
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
3486 | O_CREAT | OPEN_BINARY,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3487 auto_saving ? auto_save_mode_bits : CREAT_MODE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3488 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3489
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3490 if (desc < 0)
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 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3493 save_errno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3494 if (!auto_saving) unlock_file (lockname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3495 errno = save_errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3496 #endif /* CLASH_DETECTION */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3497 report_file_error ("Opening output file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3498 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3499
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3500 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3501 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3502 Lisp_Object instream = Qnil, outstream = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3503 struct gcpro nngcpro1, nngcpro2;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3504 NNGCPRO2 (instream, outstream);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3505
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3506 record_unwind_protect (close_file_unwind, desc_locative);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3508 if (!NILP (append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3509 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3510 if (lseek (desc, 0, 2) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3511 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3512 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3513 if (!auto_saving) unlock_file (lockname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3514 #endif /* CLASH_DETECTION */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3515 report_file_error ("Lseek error",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3516 filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3517 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3518 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3519
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3520 failure = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3521
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3522 /* Note: I tried increasing the buffering size, along with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3523 various other tricks, but nothing seemed to make much of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3524 a difference in the time it took to save a large file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3525 (Actually that's not true. With a local disk, changing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3526 the buffer size doesn't seem to make much difference.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3527 With an NFS-mounted disk, it could make a lot of difference
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3528 because you're affecting the number of network requests
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3529 that need to be made, and there could be a large latency
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3530 for each request. So I've increased the buffer size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3531 to 64K.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3532 outstream = make_filedesc_output_stream (desc, 0, -1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3533 Lstream_set_buffering (XLSTREAM (outstream),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3534 LSTREAM_BLOCKN_BUFFERED, 65536);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3535 outstream =
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
3536 make_coding_output_stream (XLSTREAM (outstream), codesys,
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
3537 CODING_ENCODE, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3538 Lstream_set_buffering (XLSTREAM (outstream),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3539 LSTREAM_BLOCKN_BUFFERED, 65536);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3540 if (STRINGP (start))
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 instream = make_lisp_string_input_stream (start, 0, -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3543 start1 = 0;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3546 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3547 LSTR_SELECTIVE |
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3548 LSTR_IGNORE_ACCESSIBLE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3549 failure = (0 > (a_write (outstream, instream, start1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3550 &annotations)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3551 save_errno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3552 /* Note that this doesn't close the desc since we created the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3553 stream without the LSTR_CLOSING flag, but it does
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3554 flush out any buffered data. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3555 if (Lstream_close (XLSTREAM (outstream)) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3556 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3557 failure = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3558 save_errno = errno;
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 Lstream_close (XLSTREAM (instream));
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 #ifdef HAVE_FSYNC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3563 /* 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
3564 Disk full in NFS may be reported here. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3565 /* 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
3566 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
3567 if (!auto_saving && fsync (desc) < 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3568 /* If fsync fails with EINTR, don't treat that as serious. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3569 && errno != EINTR)
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 failure = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3572 save_errno = errno;
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 #endif /* HAVE_FSYNC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3575
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
3576 /* 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
3577 systems where close() can change the modtime. This is known to
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
3578 happen on various NFS file systems, on Windows, and on Linux.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
3579 Rather than handling this on a per-system basis, we
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3580 unconditionally do the qxe_stat() after the retry_close(). */
428
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 /* NFS can report a write failure now. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3583 if (retry_close (desc) < 0)
428
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 failure = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3586 save_errno = errno;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3589 /* Discard the close unwind-protect. Execute the one for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3590 build_annotations (switches back to the original current buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3591 as necessary). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3592 XCAR (desc_locative) = Qnil;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3593 unbind_to (speccount);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3594
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3595 NNUNGCPRO;
428
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
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3598 qxe_stat (XSTRING_DATA (fn), &st);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3599
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3600 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3601 if (!auto_saving)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3602 unlock_file (lockname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3603 #endif /* CLASH_DETECTION */
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 /* Do this before reporting IO error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3606 to avoid a "file has changed on disk" warning on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3607 next attempt to save. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3608 if (visiting)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3609 current_buffer->modtime = st.st_mtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3610
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3611 if (failure)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3612 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3613 errno = save_errno;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3614 report_file_error ("Writing file", fn);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3615 }
428
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 if (visiting)
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 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3620 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3621 current_buffer->filename = visit_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3622 MARK_MODELINE_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3623 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3624 else if (quietly)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3625 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3626 NUNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3627 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3628 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3631 if (!auto_saving)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3632 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3633 if (visiting_other)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3634 message ("Wrote %s", XSTRING_DATA (visit_file));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3635 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3636 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3637 Lisp_Object fsp = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3638 struct gcpro nngcpro1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3639
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3640 NNGCPRO1 (fsp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3641 fsp = Ffile_symlink_p (fn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3642 if (NILP (fsp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3643 message ("Wrote %s", XSTRING_DATA (fn));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3644 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3645 message ("Wrote %s (symlink to %s)",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3646 XSTRING_DATA (fn), XSTRING_DATA (fsp));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3647 NNUNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3648 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3649 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3650 NUNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3651 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3652 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3653 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3654
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3655 /* #### 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
3656 something so stupid as a subr, just sort the fucking list more
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3657 intelligently. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3658 DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3659 Return t if (car A) is numerically less than (car B).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3660 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3661 (a, b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3662 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3663 Lisp_Object objs[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3664 objs[0] = Fcar (a);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3665 objs[1] = Fcar (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3666 return Flss (2, objs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3667 }
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 /* 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
3670 wrote the above comment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3671 DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3672 Return t if (cdr A) is numerically less than (cdr B).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3673 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3674 (a, b))
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 Lisp_Object objs[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3677 objs[0] = Fcdr (a);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3678 objs[1] = Fcdr (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3679 return Flss (2, objs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3680 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3682 /* Build the complete list of annotations appropriate for writing out
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3683 the text between START and END, by calling all the functions in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3684 write-region-annotate-functions and merging the lists they return.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3685 If one of these functions switches to a different buffer, we assume
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3686 that buffer contains altered text. Therefore, the caller must
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3687 make sure to restore the current buffer in all cases,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3688 as save-excursion would do. */
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3691 build_annotations (Lisp_Object start, Lisp_Object end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3692 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3693 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3694 Lisp_Object annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3695 Lisp_Object p, res;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3696 struct gcpro gcpro1, gcpro2;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3697 Lisp_Object original_buffer = wrap_buffer (current_buffer);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3698
428
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 annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3701 p = Vwrite_region_annotate_functions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3702 GCPRO2 (annotations, p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3703 while (!NILP (p))
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 struct buffer *given_buffer = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3706 Vwrite_region_annotations_so_far = annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3707 res = call2 (Fcar (p), start, end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3708 /* If the function makes a different buffer current,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3709 assume that means this buffer contains altered text to be output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3710 Reset START and END from the buffer bounds
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3711 and discard all previous annotations because they should have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3712 been dealt with by this function. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3713 if (current_buffer != given_buffer)
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 start = make_int (BUF_BEGV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3716 end = make_int (BUF_ZV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3717 annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3718 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3719 Flength (res); /* Check basic validity of return value */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3720 annotations = merge (annotations, res, Qcar_less_than_car);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3721 p = Fcdr (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3722 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3723
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3724 /* Now do the same for annotation functions implied by the file-format */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3725 if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3726 p = Vauto_save_file_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3727 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3728 p = current_buffer->file_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3729 while (!NILP (p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3730 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3731 struct buffer *given_buffer = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3732 Vwrite_region_annotations_so_far = annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3733 res = call4 (Qformat_annotate_function, Fcar (p), start, end,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3734 original_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3735 if (current_buffer != given_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3736 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3737 start = make_int (BUF_BEGV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3738 end = make_int (BUF_ZV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3739 annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3740 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3741 Flength (res);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3742 annotations = merge (annotations, res, Qcar_less_than_car);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3743 p = Fcdr (p);
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 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3746 return annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3747 }
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 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3750 EOF is encountered), assuming they start at position POS in the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3751 of string that STREAM refers to. Intersperse with them the annotations
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3752 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
3753 each at its appropriate position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3755 Modify *ANNOT by discarding elements as we output them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3756 The return value is negative in case of system call failure. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3757
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3758 /* 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
3759 function calls to reasonable level. The Lstream stuff itself will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3760 batch to 64K to reduce the number of system calls. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3761
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3762 #define A_WRITE_BATCH_SIZE 4096
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3763
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3764 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3765 a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3766 Lisp_Object *annot)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3767 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3768 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3769 int nextpos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3770 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3771 Lstream *instr = XLSTREAM (instream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3772 Lstream *outstr = XLSTREAM (outstream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3773
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3774 while (LISTP (*annot))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3775 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3776 tem = Fcar_safe (Fcar (*annot));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3777 if (INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3778 nextpos = XINT (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3779 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3780 nextpos = INT_MAX;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3781 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3782 /* If there are annotations left and we have Mule, then we
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3783 have to do the I/O one ichar at a time so we can
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3784 determine when to insert the annotation. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3785 if (!NILP (*annot))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3786 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3787 Ichar ch;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3788 while (pos != nextpos && (ch = Lstream_get_ichar (instr)) != EOF)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3789 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3790 if (Lstream_put_ichar (outstr, ch) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3791 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3792 pos++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3793 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3794 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3795 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3796 #endif /* MULE */
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 while (pos != nextpos)
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 /* Otherwise there is no point to that. Just go in batches. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3801 int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE);
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 chunk = Lstream_read (instr, largebuf, chunk);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3804 if (chunk < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3805 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3806 if (chunk == 0) /* EOF */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3807 break;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3808 if (Lstream_write (outstr, largebuf, chunk) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3809 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3810 pos += chunk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3811 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3812 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3813 if (pos == nextpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3814 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3815 tem = Fcdr (Fcar (*annot));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3816 if (STRINGP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3817 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3818 if (Lstream_write (outstr, XSTRING_DATA (tem),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3819 XSTRING_LENGTH (tem)) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3820 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3821 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3822 *annot = Fcdr (*annot);
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3825 return 0;
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 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3828 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3829
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3832 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3833 #include <des_crypt.h>
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 #define CRYPT_BLOCK_SIZE 8 /* bytes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3836 #define CRYPT_KEY_SIZE 8 /* bytes */
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 DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3839 Encrypt STRING using KEY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3840 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3841 (string, key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3842 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
3843 /* !!#### Needs work */
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3844 Extbyte *encrypted_string, *raw_key;
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3845 Extbyte *string_ext, *key_ext;
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3846 Bytecount string_size_ext, key_size_ext, rounded_size, extra, key_size;
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3847
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3848 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3849 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3850
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3851 LISP_STRING_TO_SIZED_EXTERNAL (string, string_ext, string_size_ext, Qbinary);
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3852 LISP_STRING_TO_SIZED_EXTERNAL (key, key_ext, key_size_ext, Qbinary);
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3853
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3854 extra = string_size_ext % CRYPT_BLOCK_SIZE;
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3855 rounded_size = string_size_ext + extra;
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 844
diff changeset
3856 encrypted_string = ALLOCA (rounded_size + 1);
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3857 memcpy (encrypted_string, string_ext, string_size_ext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3858 memset (encrypted_string + rounded_size - extra, 0, extra + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3859
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3860 key_size = min (CRYPT_KEY_SIZE, key_size_ext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3861
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 844
diff changeset
3862 raw_key = ALLOCA (CRYPT_KEY_SIZE + 1);
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3863 memcpy (raw_key, key_ext, key_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3864 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3865
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3866 ecb_crypt (raw_key, encrypted_string, rounded_size,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3867 DES_ENCRYPT | DES_SW);
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3868 return make_ext_string (encrypted_string, rounded_size, Qbinary);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3869 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3870
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3871 DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3872 Decrypt STRING using KEY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3873 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3874 (string, key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3875 {
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3876 Extbyte *decrypted_string, *raw_key;
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3877 Extbyte *string_ext, *key_ext;
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3878 Bytecount string_size_ext, key_size_ext, string_size, key_size;
428
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 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3881 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3882
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3883 LISP_STRING_TO_SIZED_EXTERNAL (string, string_ext, string_size_ext, Qbinary);
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3884 LISP_STRING_TO_SIZED_EXTERNAL (key, key_ext, key_size_ext, Qbinary);
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3885
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3886 string_size = string_size_ext + 1;
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 844
diff changeset
3887 decrypted_string = ALLOCA (string_size);
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3888 memcpy (decrypted_string, string_ext, string_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3889 decrypted_string[string_size - 1] = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3890
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3891 key_size = min (CRYPT_KEY_SIZE, key_size_ext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3892
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 844
diff changeset
3893 raw_key = ALLOCA (CRYPT_KEY_SIZE + 1);
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3894 memcpy (raw_key, key_ext, key_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3895 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3896
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3897
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3898 ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW);
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
3899 return make_ext_string (decrypted_string, string_size - 1, Qbinary);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3900 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3901 #endif /* 0 */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3904 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
3905 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
3906 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
3907 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3908 (buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3909 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3910 /* This function can call lisp; GC checked 2000-07-11 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3911 struct buffer *b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3912 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3913 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3914
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3915 CHECK_BUFFER (buffer);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3916 b = XBUFFER (buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3917
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3918 if (!STRINGP (b->filename)) return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3919 if (b->modtime == 0) return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3920
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3921 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3922 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3923 handler = Ffind_file_name_handler (b->filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3924 Qverify_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3925 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3926 return call2 (handler, Qverify_visited_file_modtime, buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3927
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3928 if (qxe_stat (XSTRING_DATA (b->filename), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3929 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3930 /* If the file doesn't exist now and didn't exist before,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3931 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
3932 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3933 st.st_mtime = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3934 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3935 st.st_mtime = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3936 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3937 if (st.st_mtime == b->modtime
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3938 /* 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
3939 || (st.st_mtime > 0 && b->modtime > 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3940 && (st.st_mtime == b->modtime + 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3941 || st.st_mtime == b->modtime - 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3942 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3943 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3944 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3945
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3946 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3947 Clear out records of last mod time of visited file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3948 Next attempt to save will certainly not complain of a discrepancy.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3949 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3950 ())
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 current_buffer->modtime = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3953 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3954 }
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 DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3957 Return the current buffer's recorded visited file modification time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3958 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
3959 that `file-attributes' returns.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3960 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3961 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3962 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3963 return time_to_lisp ((time_t) current_buffer->modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3964 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3965
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3966 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3967 Update buffer's recorded modification time from the visited file's time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3968 Useful if the buffer was not read from the file normally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3969 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
3970 An argument specifies the modification time value to use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3971 \(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
3972 \(HIGH . LOW) or (HIGH LOW).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3973 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3974 (time_list))
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 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3977 if (!NILP (time_list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3978 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3979 time_t the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3980 lisp_to_time (time_list, &the_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3981 current_buffer->modtime = (int) the_time;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3984 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3985 Lisp_Object filename = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3986 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3987 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3988 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3989
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3990 GCPRO3 (filename, time_list, current_buffer->filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3991 filename = Fexpand_file_name (current_buffer->filename, Qnil);
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 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3994 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3995 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3996 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3997 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3998 /* The handler can find the file name the same way we did. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3999 return call2 (handler, Qset_visited_file_modtime, Qnil);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4000 else if (qxe_stat (XSTRING_DATA (filename), &st) >= 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4001 current_buffer->modtime = st.st_mtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4002 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4003
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4004 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4005 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4006
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4007 static Lisp_Object
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
4008 auto_save_error (Lisp_Object UNUSED (condition_object),
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
4009 Lisp_Object UNUSED (ignored))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4010 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4011 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4012 if (gc_in_progress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4013 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4014 /* Don't try printing an error message after everything is gone! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4015 if (preparing_for_armageddon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4016 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4017 clear_echo_area (selected_frame (), Qauto_saving, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4018 Fding (Qt, Qauto_save_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4019 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4020 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4021 message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4022 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4023 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4024 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4025 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4026 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4027
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4028 static Lisp_Object
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
4029 auto_save_1 (Lisp_Object UNUSED (ignored))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4030 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4031 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4032 /* #### I think caller is protecting current_buffer? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4033 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4034 Lisp_Object fn = current_buffer->filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4035 Lisp_Object a = current_buffer->auto_save_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4036
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4037 if (!STRINGP (a))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4038 return (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4039
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4040 /* 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
4041 if (STRINGP (fn) &&
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4042 qxe_stat (XSTRING_DATA (fn), &st) >= 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4043 /* But make sure we can overwrite it later! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4044 auto_save_mode_bits = st.st_mode | 0600;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4045 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4046 /* default mode for auto-save files of buffers with no file is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4047 readable by owner only. This may annoy some small number of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4048 people, but the alternative removes all privacy from email. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4049 auto_save_mode_bits = 0600;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4050
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4051 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4052 Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4053 #if 1 /* #### Kyle wants it changed to not use escape-quoted. Think
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4054 carefully about how this works. */
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
4055 Qescape_quoted,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4056 #else
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
4057 current_buffer->buffer_file_coding_system,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4058 #endif
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
4059 Qnil);
428
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 static Lisp_Object
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
4063 auto_save_expand_name_error (Lisp_Object condition_object,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
4064 Lisp_Object UNUSED (ignored))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4065 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4066 warn_when_safe_lispobj
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
4067 (Qfile, Qerror,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4068 Fcons (build_msg_string ("Invalid auto-save list-file"),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4069 Fcons (Vauto_save_list_file_name,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4070 condition_object)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4071 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4072 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4075 auto_save_expand_name (Lisp_Object name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4076 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4077 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4078
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4079 /* note that caller did NOT gc protect name, so we do it. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4080 /* [[dmoore - this might not be necessary, if condition_case_1
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4081 protects it. but I don't think it does.]] indeed it doesn't. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4082 GCPRO1 (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4083 RETURN_UNGCPRO (Fexpand_file_name (name, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4084 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4085
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4086
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4087 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4088 do_auto_save_unwind (Lisp_Object fd)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4089 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4090 retry_close (XINT (fd));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4091 return (fd);
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 /* 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
4095 and if so, tries to avoid touching lisp objects.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4096
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4097 The only time that Fdo_auto_save() is called while GC is in progress
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2421
diff changeset
4098 is if we're going down, as a result of an ABORT() or a kill signal.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4099 It's fairly important that we generate autosave files in that case!
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4102 DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4103 Auto-save all buffers that need it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4104 This is all buffers that have auto-saving enabled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4105 and are changed since last auto-saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4106 Auto-saving writes the buffer into a file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4107 so that your editing is not lost if the system crashes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4108 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
4109 Normally we run the normal hook `auto-save-hook' before saving.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4111 Non-nil first argument means do not print any message if successful.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4112 Non-nil second argument means save only current buffer.
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 (no_message, current_only))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4115 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4116 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4117 struct buffer *b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4118 Lisp_Object tail, buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4119 int auto_saved = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4120 int do_handled_files;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4121 Lisp_Object oquit = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4122 Lisp_Object listfile = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4123 Lisp_Object old;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4124 int listdesc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4125 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4126 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4127
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
4128 old = wrap_buffer (current_buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4129 GCPRO3 (oquit, listfile, old);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4130 check_quit (); /* make Vquit_flag accurate */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4131 /* Ordinarily don't quit within this function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4132 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
4133 oquit = Vquit_flag;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4134 Vquit_flag = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4136 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4137 variables point to non-strings reached from Vbuffer_alist. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4139 if (minibuf_level != 0 || preparing_for_armageddon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4140 no_message = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4142 run_hook (Qauto_save_hook);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4144 if (STRINGP (Vauto_save_list_file_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4145 listfile = condition_case_1 (Qt,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4146 auto_save_expand_name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4147 Vauto_save_list_file_name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4148 auto_save_expand_name_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4149
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
4150 internal_bind_int (&auto_saving, 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4152 /* First, save all files which don't have handlers. If Emacs is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4153 crashing, the handlers may tweak what is causing Emacs to crash
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4154 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
4155 autosave perfectly ordinary files because it couldn't handle some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4156 ange-ftp'd file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4157 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4158 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4159 for (tail = Vbuffer_alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4160 CONSP (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4161 tail = XCDR (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4162 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4163 buf = XCDR (XCAR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4164 b = XBUFFER (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4166 if (!NILP (current_only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4167 && b != current_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4168 continue;
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 /* Don't auto-save indirect buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4171 The base buffer takes care of it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4172 if (b->base_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4173 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4174
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4175 /* Check for auto save enabled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4176 and file changed since last auto save
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4177 and file changed since last real save. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4178 if (STRINGP (b->auto_save_file_name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4179 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4180 && b->auto_save_modified < BUF_MODIFF (b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4181 /* -1 means we've turned off autosaving for a while--see below. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4182 && XINT (b->saved_size) >= 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4183 && (do_handled_files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4184 || NILP (Ffind_file_name_handler (b->auto_save_file_name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4185 Qwrite_region))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4186 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4187 EMACS_TIME before_time, after_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4189 EMACS_GET_TIME (before_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4190 /* If we had a failure, don't try again for 20 minutes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4191 if (!preparing_for_armageddon
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4192 && b->auto_save_failure_time >= 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4193 && (EMACS_SECS (before_time) - b->auto_save_failure_time <
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4194 1200))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4195 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4197 if (!preparing_for_armageddon &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4198 (XINT (b->saved_size) * 10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4199 > (BUF_Z (b) - BUF_BEG (b)) * 13)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4200 /* A short file is likely to change a large fraction;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4201 spare the user annoying messages. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4202 && XINT (b->saved_size) > 5000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4203 /* These messages are frequent and annoying for `*mail*'. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4204 && !NILP (b->filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4205 && NILP (no_message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4206 && disable_auto_save_when_buffer_shrinks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4207 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4208 /* It has shrunk too much; turn off auto-saving here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4209 Unless we're about to crash, in which case auto-save it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4210 anyway.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4211 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4212 message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4213 ("Buffer %s has shrunk a lot; auto save turned off there",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4214 XSTRING_DATA (b->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4215 /* Turn off auto-saving until there's a real save,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4216 and prevent any more warnings. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4217 b->saved_size = make_int (-1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4218 if (!gc_in_progress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4219 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4220 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4221 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4222 set_buffer_internal (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4223 if (!auto_saved && NILP (no_message))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4224 {
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
4225 static const Ibyte *msg = (const Ibyte *) "Auto-saving...";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4226 echo_area_message (selected_frame (), msg, Qnil,
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
4227 0, qxestrlen (msg),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4228 Qauto_saving);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4229 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4231 /* Open the auto-save list file, if necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4232 We only do this now so that the file only exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4233 if we actually auto-saved any files. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4234 if (!auto_saved && !inhibit_auto_save_session
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4235 && !NILP (Vauto_save_list_file_prefix)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4236 && STRINGP (listfile) && listdesc < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4237 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4238 listdesc =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4239 qxe_open (XSTRING_DATA (listfile),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4240 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4241 CREAT_MODE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4243 /* Arrange to close that file whether or not we get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4244 an error. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4245 if (listdesc >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4246 record_unwind_protect (do_auto_save_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4247 make_int (listdesc));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4248 }
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 /* Record all the buffers that we are auto-saving in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4251 the special file that lists them. For each of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4252 these buffers, record visited name (if any) and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4253 auto save name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4254 if (listdesc >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4255 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4256 const Extbyte *auto_save_file_name_ext;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
4257 Bytecount auto_save_file_name_ext_len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4258
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4259 TO_EXTERNAL_FORMAT (LISP_STRING, b->auto_save_file_name,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4260 ALLOCA, (auto_save_file_name_ext,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4261 auto_save_file_name_ext_len),
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4262 Qescape_quoted);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4263 if (!NILP (b->filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4264 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4265 const Extbyte *filename_ext;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
4266 Bytecount filename_ext_len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4267
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4268 TO_EXTERNAL_FORMAT (LISP_STRING, b->filename,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4269 ALLOCA, (filename_ext,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4270 filename_ext_len),
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4271 Qescape_quoted);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4272 retry_write (listdesc, filename_ext, filename_ext_len);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4273 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4274 retry_write (listdesc, "\n", 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4275 retry_write (listdesc, auto_save_file_name_ext,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4276 auto_save_file_name_ext_len);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4277 retry_write (listdesc, "\n", 1);
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4280 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4281 based on values in Vbuffer_alist. auto_save_1 may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4282 cause lisp handlers to run. Those handlers may kill
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4283 the buffer and then GC. Since the buffer is killed,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4284 it's no longer in Vbuffer_alist so it might get reaped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4285 by the GC. We also need to protect tail. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4286 /* #### There is probably a lot of other code which has
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4287 pointers into buffers which may get blown away by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4288 handlers. */
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 struct gcpro ngcpro1, ngcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4291 NGCPRO2 (buf, tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4292 condition_case_1 (Qt,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4293 auto_save_1, Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4294 auto_save_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4295 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4296 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4297 /* Handler killed our saved current-buffer! Pick any. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4298 if (!BUFFER_LIVE_P (XBUFFER (old)))
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
4299 old = wrap_buffer (current_buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4301 set_buffer_internal (XBUFFER (old));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4302 auto_saved++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4304 /* Handler killed their own buffer! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4305 if (!BUFFER_LIVE_P(b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4306 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4308 b->auto_save_modified = BUF_MODIFF (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4309 b->saved_size = make_int (BUF_SIZE (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4310 EMACS_GET_TIME (after_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4311 /* If auto-save took more than 60 seconds,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4312 assume it was an NFS failure that got a timeout. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4313 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4314 b->auto_save_failure_time = EMACS_SECS (after_time);
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 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4319 /* Prevent another auto save till enough input events come in. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4320 if (auto_saved)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4321 record_auto_save ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4323 /* If we didn't save anything into the listfile, remove the old
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4324 one because nothing needed to be auto-saved. Do this afterwards
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4325 rather than before in case we get a crash attempting to autosave
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4326 (in that case we'd still want the old one around). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4327 if (listdesc < 0 && !auto_saved && STRINGP (listfile))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4328 qxe_unlink (XSTRING_DATA (listfile));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4329
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4330 /* Show "...done" only if the echo area would otherwise be empty. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4331 if (auto_saved && NILP (no_message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4332 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4333 {
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
4334 static const Ibyte *msg = (const Ibyte *)"Auto-saving...done";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4335 echo_area_message (selected_frame (), msg, Qnil, 0,
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1315
diff changeset
4336 qxestrlen (msg), Qauto_saving);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4337 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4339 Vquit_flag = oquit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4340
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4341 RETURN_UNGCPRO (unbind_to (speccount));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4342 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4344 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4345 Mark current buffer as auto-saved with its current text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4346 No auto-save file will be written until the buffer changes again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4347 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4348 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4349 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4350 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4351 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4352 current_buffer->auto_save_failure_time = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4353 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4354 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4355
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4356 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
4357 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
4358 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4359 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4360 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4361 current_buffer->auto_save_failure_time = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4362 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4363 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4365 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4366 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
4367 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4368 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4369 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4370 return (BUF_SAVE_MODIFF (current_buffer) <
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4371 current_buffer->auto_save_modified) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4372 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4373
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4375 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4376 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4377 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4379 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4380 syms_of_fileio (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4381 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4382 DEFSYMBOL (Qexpand_file_name);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4383 DEFSYMBOL (Qfile_truename);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4384 DEFSYMBOL (Qsubstitute_in_file_name);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4385 DEFSYMBOL (Qdirectory_file_name);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4386 DEFSYMBOL (Qfile_name_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4387 DEFSYMBOL (Qfile_name_nondirectory);
996
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 988
diff changeset
4388 DEFSYMBOL (Qfile_name_sans_extension);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4389 DEFSYMBOL (Qunhandled_file_name_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4390 DEFSYMBOL (Qfile_name_as_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4391 DEFSYMBOL (Qcopy_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4392 DEFSYMBOL (Qmake_directory_internal);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4393 DEFSYMBOL (Qdelete_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4394 DEFSYMBOL (Qdelete_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4395 DEFSYMBOL (Qrename_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4396 DEFSYMBOL (Qadd_name_to_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4397 DEFSYMBOL (Qmake_symbolic_link);
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
4398 DEFSYMBOL (Qmake_temp_name);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4399 DEFSYMBOL (Qfile_exists_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4400 DEFSYMBOL (Qfile_executable_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4401 DEFSYMBOL (Qfile_readable_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4402 DEFSYMBOL (Qfile_symlink_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4403 DEFSYMBOL (Qfile_writable_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4404 DEFSYMBOL (Qfile_directory_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4405 DEFSYMBOL (Qfile_regular_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4406 DEFSYMBOL (Qfile_accessible_directory_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4407 DEFSYMBOL (Qfile_modes);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4408 DEFSYMBOL (Qset_file_modes);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4409 DEFSYMBOL (Qfile_newer_than_file_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4410 DEFSYMBOL (Qinsert_file_contents);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4411 DEFSYMBOL (Qwrite_region);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4412 DEFSYMBOL (Qverify_visited_file_modtime);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4413 DEFSYMBOL (Qset_visited_file_modtime);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4414 DEFSYMBOL (Qcar_less_than_car); /* Vomitous! */
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 3841
diff changeset
4415 DEFSYMBOL (Qexcl);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4416
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4417 DEFSYMBOL (Qauto_save_hook);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4418 DEFSYMBOL (Qauto_save_error);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4419 DEFSYMBOL (Qauto_saving);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4420
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4421 DEFSYMBOL (Qformat_decode);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4422 DEFSYMBOL (Qformat_annotate_function);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4423
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4424 DEFSYMBOL (Qcompute_buffer_file_truename);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4425
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4426 DEFERROR_STANDARD (Qfile_already_exists, Qfile_error);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4428 DEFSUBR (Ffind_file_name_handler);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4429
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4430 DEFSUBR (Ffile_name_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4431 DEFSUBR (Ffile_name_nondirectory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4432 DEFSUBR (Funhandled_file_name_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4433 DEFSUBR (Ffile_name_as_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4434 DEFSUBR (Fdirectory_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4435 DEFSUBR (Fmake_temp_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4436 DEFSUBR (Fexpand_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4437 DEFSUBR (Ffile_truename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4438 DEFSUBR (Fsubstitute_in_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4439 DEFSUBR (Fcopy_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4440 DEFSUBR (Fmake_directory_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4441 DEFSUBR (Fdelete_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4442 DEFSUBR (Fdelete_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4443 DEFSUBR (Frename_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4444 DEFSUBR (Fadd_name_to_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4445 DEFSUBR (Fmake_symbolic_link);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4446 #ifdef HPUX_NET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4447 DEFSUBR (Fsysnetunam);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4448 #endif /* HPUX_NET */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4449 DEFSUBR (Ffile_name_absolute_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4450 DEFSUBR (Ffile_exists_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4451 DEFSUBR (Ffile_executable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4452 DEFSUBR (Ffile_readable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4453 DEFSUBR (Ffile_writable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4454 DEFSUBR (Ffile_symlink_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4455 DEFSUBR (Ffile_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4456 DEFSUBR (Ffile_accessible_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4457 DEFSUBR (Ffile_regular_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4458 DEFSUBR (Ffile_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4459 DEFSUBR (Fset_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4460 DEFSUBR (Fset_default_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4461 DEFSUBR (Fdefault_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4462 DEFSUBR (Funix_sync);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4463 DEFSUBR (Ffile_newer_than_file_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4464 DEFSUBR (Finsert_file_contents_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4465 DEFSUBR (Fwrite_region_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4466 DEFSUBR (Fcar_less_than_car); /* Vomitous! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4467 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4468 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4469 DEFSUBR (Fencrypt_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4470 DEFSUBR (Fdecrypt_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4471 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4472 DEFSUBR (Fverify_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4473 DEFSUBR (Fclear_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4474 DEFSUBR (Fvisited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4475 DEFSUBR (Fset_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4476
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4477 DEFSUBR (Fdo_auto_save);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4478 DEFSUBR (Fset_buffer_auto_saved);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4479 DEFSUBR (Fclear_buffer_auto_save_failure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4480 DEFSUBR (Frecent_auto_save_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4481 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4482
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4483 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4484 vars_of_fileio (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4485 {
2526
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
4486 QSin_expand_file_name =
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
4487 build_msg_string ("(in expand-file-name)");
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
4488 staticpro (&QSin_expand_file_name);
902d5bd9b75c [xemacs-hg @ 2005-01-28 02:36:11 by ben]
ben
parents: 2500
diff changeset
4489
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4490 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4491 *Format in which to write auto-save files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4492 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
4493 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
4494 same format as a regular save would use.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4495 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4496 Vauto_save_file_format = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4498 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4499 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4500 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
4501 HANDLER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4503 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
4504 to be handled; the remaining arguments are the arguments that were
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4505 passed to that primitive. For example, if you do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4506 (file-exists-p FILENAME)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4507 and FILENAME is handled by HANDLER, then HANDLER is called like this:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4508 (funcall HANDLER 'file-exists-p FILENAME)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4509 The function `find-file-name-handler' checks this list for a handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4510 for its argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4511 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4512 Vfile_name_handler_alist = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4513
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4514 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4515 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
4516 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
4517 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
4518 intercepted by a handler from `file-name-handler-alist', that handler is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4519 responsible for calling the after-insert-file-functions if appropriate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4520 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4521 Vafter_insert_file_functions = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4522
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4523 DEFVAR_LISP ("write-region-annotate-functions",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4524 &Vwrite_region_annotate_functions /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4525 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
4526 Each is passed two arguments, START and END, as for `write-region'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4527 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
4528 effectively inserted at the specified positions of the file being written
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4529 \(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
4530 sorted into increasing order. If there are several functions in the list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4531 the several lists are merged destructively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4532 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4533 Vwrite_region_annotate_functions = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4534
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4535 DEFVAR_LISP ("write-region-annotations-so-far",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4536 &Vwrite_region_annotations_so_far /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4537 When an annotation function is called, this holds the previous annotations.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4538 These are the annotations made by other annotation functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4539 that were already called. See also `write-region-annotate-functions'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4540 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4541 Vwrite_region_annotations_so_far = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4542
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4543 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4544 A list of file name handlers that temporarily should not be used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4545 This applies only to the operation `inhibit-file-name-operation'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4546 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4547 Vinhibit_file_name_handlers = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4549 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4550 The operation for which `inhibit-file-name-handlers' is applicable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4551 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4552 Vinhibit_file_name_operation = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4553
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4554 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4555 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
4556 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4557 Vauto_save_list_file_name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4558
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4559 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
4560 Prefix for generating auto-save-list-file-name.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4561 Emacs's pid and the system name will be appended to
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4562 this prefix to create a unique file name.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4563 */ );
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4564 Vauto_save_list_file_prefix = build_string ("~/.saves-");
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4565
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4566 DEFVAR_BOOL ("inhibit-auto-save-session", &inhibit_auto_save_session /*
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4567 When non-nil, inhibit auto save list file creation.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4568 */ );
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4569 inhibit_auto_save_session = 0;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4570
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4571 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4572 &disable_auto_save_when_buffer_shrinks /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4573 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
4574 This is to prevent you from losing your edits if you accidentally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4575 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
4576 Saving the buffer normally turns auto-save back on.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4577 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4578 disable_auto_save_when_buffer_shrinks = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4579
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4580 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4581 Directory separator character for built-in functions that return file names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4582 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4583 This variable affects the built-in functions only on Windows,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4584 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
4585 what the normal separator is.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4586 */ );
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4587 Vdirectory_sep_char = make_char (DEFAULT_DIRECTORY_SEP);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4588 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4589
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4590 void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4591 reinit_vars_of_fileio (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4592 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4593 /* 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
4594 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
4595 two different XEmacs processes using the same binary on different
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4596 machines creating temp files in the same directory will be
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4597 unlucky enough to have the same pid. If we randomize using
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4598 process startup time, then in practice they will be unlikely to
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4599 collide. We use the microseconds field so that scripts that start
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4600 simultaneous XEmacs processes on multiple machines will have less
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4601 chance of collision. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4602 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4603 EMACS_TIME thyme;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4604
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4605 EMACS_GET_TIME (thyme);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4606 temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4607 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4608 }