annotate src/fileio.c @ 1869:30eb06b22ae4

* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell users that buffers have shrunk a lot. This is called when Emacs is crashing, so we don't want to run any code that isn't absolutely necessary. Also, autosave buffers which don't have specially handled autosave file names first. * fileio.c (Fexpand_file_name): Pass DEFALT through Fexpand_file_name before using it. * fileio.c (Fexpand_file_name): Doc fix.
author Jim Blandy <jimb@redhat.com>
date Sun, 14 Feb 1993 14:37:33 +0000
parents f9ac4c0d8b72
children c26427fc12e2
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1 /* File IO for GNU Emacs.
621
eca8812e61cd *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 595
diff changeset
2 Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4 This file is part of GNU Emacs.
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6 GNU Emacs is free software; you can redistribute it and/or modify
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7 it under the terms of the GNU General Public License as published by
621
eca8812e61cd *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 595
diff changeset
8 the Free Software Foundation; either version 2, or (at your option)
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
9 any later version.
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
10
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
11 GNU Emacs is distributed in the hope that it will be useful,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 GNU General Public License for more details.
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17 along with GNU Emacs; see the file COPYING. If not, write to
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
19
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 621
diff changeset
20 #include "config.h"
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
21
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
22 #include <sys/types.h>
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
23 #include <sys/stat.h>
372
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
24
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
25 #ifdef VMS
564
d909f2be7ee1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 550
diff changeset
26 #include "vms-pwd.h"
372
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
27 #else
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
28 #include <pwd.h>
372
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
29 #endif
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
30
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
31 #include <ctype.h>
372
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
32
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
33 #ifdef VMS
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
34 #include "dir.h"
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
35 #include <perror.h>
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
36 #include <stddef.h>
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
37 #include <string.h>
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
38 #endif
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
39
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
40 #include <errno.h>
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
41
372
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
42 #ifndef vax11c
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
43 extern int errno;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
44 extern char *sys_errlist[];
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
45 extern int sys_nerr;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
46 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
47
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
48 #define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
49
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
50 #ifdef APOLLO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
51 #include <sys/time.h>
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
52 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
53
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
54 #include "lisp.h"
1299
b8337cdf2e8b * fileio.c (Finsert_file_contents): Call offset_intervals() if
Joseph Arceneaux <jla@gnu.org>
parents: 1240
diff changeset
55 #include "intervals.h"
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
56 #include "buffer.h"
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
57 #include "window.h"
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
58
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
59 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
60 #include <file.h>
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
61 #include <rmsdef.h>
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
62 #include <fab.h>
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
63 #include <nam.h>
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
64 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
65
564
d909f2be7ee1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 550
diff changeset
66 #include "systime.h"
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
67
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
68 #ifdef HPUX
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
69 #include <netio.h>
350
80a890dbbeb5 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 230
diff changeset
70 #ifndef HPUX8
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
71 #include <errnet.h>
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
72 #endif
350
80a890dbbeb5 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 230
diff changeset
73 #endif
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
74
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
75 #ifndef O_WRONLY
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
76 #define O_WRONLY 1
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
77 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
78
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
79 #define min(a, b) ((a) < (b) ? (a) : (b))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
80 #define max(a, b) ((a) > (b) ? (a) : (b))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
81
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
82 /* Nonzero during writing of auto-save files */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
83 int auto_saving;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
84
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
85 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
86 a new file with the same mode as the original */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
87 int auto_save_mode_bits;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
88
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
89 /* Alist of elements (REGEXP . HANDLER) for file names
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
90 whose I/O is done with a special handler. */
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
91 Lisp_Object Vfile_name_handler_alist;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
92
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
93 /* Nonzero means, when reading a filename in the minibuffer,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
94 start out by inserting the default directory into the minibuffer. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
95 int insert_default_directory;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
96
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
97 /* On VMS, nonzero means write new files with record format stmlf.
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
98 Zero means use var format. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
99 int vms_stmlf_recfm;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
100
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
101 Lisp_Object Qfile_error, Qfile_already_exists;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
102
863
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
103 Lisp_Object Qfile_name_history;
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
104
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
105 report_file_error (string, data)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
106 char *string;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
107 Lisp_Object data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
108 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
109 Lisp_Object errstring;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
110
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
111 if (errno >= 0 && errno < sys_nerr)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
112 errstring = build_string (sys_errlist[errno]);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
113 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
114 errstring = build_string ("undocumented error code");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
115
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
116 /* System error messages are capitalized. Downcase the initial
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
117 unless it is followed by a slash. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
118 if (XSTRING (errstring)->data[1] != '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
119 XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
120
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
121 while (1)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
122 Fsignal (Qfile_error,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
123 Fcons (build_string (string), Fcons (errstring, data)));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
124 }
592
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
125
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
126 close_file_unwind (fd)
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
127 Lisp_Object fd;
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
128 {
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
129 close (XFASTINT (fd));
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
130 }
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
131
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
132 Lisp_Object Qexpand_file_name;
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
133 Lisp_Object Qdirectory_file_name;
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
134 Lisp_Object Qfile_name_directory;
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
135 Lisp_Object Qfile_name_nondirectory;
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
136 Lisp_Object Qunhandled_file_name_directory;
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
137 Lisp_Object Qfile_name_as_directory;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
138 Lisp_Object Qcopy_file;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
139 Lisp_Object Qmake_directory;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
140 Lisp_Object Qdelete_directory;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
141 Lisp_Object Qdelete_file;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
142 Lisp_Object Qrename_file;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
143 Lisp_Object Qadd_name_to_file;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
144 Lisp_Object Qmake_symbolic_link;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
145 Lisp_Object Qfile_exists_p;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
146 Lisp_Object Qfile_executable_p;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
147 Lisp_Object Qfile_readable_p;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
148 Lisp_Object Qfile_symlink_p;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
149 Lisp_Object Qfile_writable_p;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
150 Lisp_Object Qfile_directory_p;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
151 Lisp_Object Qfile_accessible_directory_p;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
152 Lisp_Object Qfile_modes;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
153 Lisp_Object Qset_file_modes;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
154 Lisp_Object Qfile_newer_than_file_p;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
155 Lisp_Object Qinsert_file_contents;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
156 Lisp_Object Qwrite_region;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
157 Lisp_Object Qverify_visited_file_modtime;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
158
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
159 DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 1, 1, 0,
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
160 "Return FILENAME's handler function, if its syntax is handled specially.\n\
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
161 Otherwise, return nil.\n\
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
162 A file name is handled if one of the regular expressions in\n\
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
163 `file-name-handler-alist' matches it.")
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
164 (filename)
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
165 Lisp_Object filename;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
166 {
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
167 /* This function must not munge the match data. */
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
168
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
169 Lisp_Object chain;
848
58d3ed08f776 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 843
diff changeset
170 for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
171 chain = XCONS (chain)->cdr)
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
172 {
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
173 Lisp_Object elt;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
174 elt = XCONS (chain)->car;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
175 if (XTYPE (elt) == Lisp_Cons)
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
176 {
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
177 Lisp_Object string;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
178 string = XCONS (elt)->car;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
179 if (XTYPE (string) == Lisp_String
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
180 && fast_string_match (string, filename) >= 0)
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
181 return XCONS (elt)->cdr;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
182 }
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
183
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
184 QUIT;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
185 }
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
186 return Qnil;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
187 }
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
188
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
189 DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
190 1, 1, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
191 "Return the directory component in file name NAME.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
192 Return nil if NAME does not include a directory.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
193 Otherwise return a directory spec.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
194 Given a Unix syntax file name, returns a string ending in slash;\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
195 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
196 (file)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
197 Lisp_Object file;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
198 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
199 register unsigned char *beg;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
200 register unsigned char *p;
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
201 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
202
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
203 CHECK_STRING (file, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
204
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
205 /* If the file name has special constructs in it,
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
206 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
207 handler = Ffind_file_name_handler (file);
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
208 if (!NILP (handler))
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
209 return call2 (handler, Qfile_name_directory, file);
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
210
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
211 beg = XSTRING (file)->data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
212 p = beg + XSTRING (file)->size;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
213
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
214 while (p != beg && p[-1] != '/'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
215 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
216 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
217 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
218 ) p--;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
219
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
220 if (p == beg)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
221 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
222 return make_string (beg, p - beg);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
223 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
224
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
225 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
226 1, 1, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
227 "Return file name NAME sans its directory.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
228 For example, in a Unix-syntax file name,\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
229 this is everything after the last slash,\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
230 or the entire name if it contains no slash.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
231 (file)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
232 Lisp_Object file;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
233 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
234 register unsigned char *beg, *p, *end;
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
235 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
236
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
237 CHECK_STRING (file, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
238
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
239 /* If the file name has special constructs in it,
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
240 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
241 handler = Ffind_file_name_handler (file);
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
242 if (!NILP (handler))
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
243 return call2 (handler, Qfile_name_nondirectory, file);
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
244
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
245 beg = XSTRING (file)->data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
246 end = p = beg + XSTRING (file)->size;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
247
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
248 while (p != beg && p[-1] != '/'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
249 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
250 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
251 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
252 ) p--;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
253
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
254 return make_string (p, end - p);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
255 }
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
256
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
257 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, Sunhandled_file_name_directory, 1, 1, 0,
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
258 "Return a directly usable directory name somehow associated with FILENAME.\n\
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
259 A `directly usable' directory name is one that may be used without the\n\
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
260 intervention of any file handler.\n\
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
261 If FILENAME is a directly usable file itself, return\n\
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
262 (file-name-directory FILENAME).\n\
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
263 The `call-process' and `start-process' functions use this function to\n\
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
264 get a current directory to run processes in.")
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
265 (filename)
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
266 Lisp_Object filename;
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
267 {
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
268 Lisp_Object handler;
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
269
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
270 /* If the file name has special constructs in it,
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
271 call the corresponding file handler. */
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
272 handler = Ffind_file_name_handler (filename);
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
273 if (!NILP (handler))
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
274 return call2 (handler, Qunhandled_file_name_directory, filename);
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
275
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
276 return Ffile_name_directory (filename);
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
277 }
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
278
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
279
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
280 char *
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
281 file_name_as_directory (out, in)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
282 char *out, *in;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
283 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
284 int size = strlen (in) - 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
285
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
286 strcpy (out, in);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
287
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
288 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
289 /* Is it already a directory string? */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
290 if (in[size] == ':' || in[size] == ']' || in[size] == '>')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
291 return out;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
292 /* Is it a VMS directory file name? If so, hack VMS syntax. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
293 else if (! index (in, '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
294 && ((size > 3 && ! strcmp (&in[size - 3], ".DIR"))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
295 || (size > 3 && ! strcmp (&in[size - 3], ".dir"))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
296 || (size > 5 && (! strncmp (&in[size - 5], ".DIR", 4)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
297 || ! strncmp (&in[size - 5], ".dir", 4))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
298 && (in[size - 1] == '.' || in[size - 1] == ';')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
299 && in[size] == '1')))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
300 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
301 register char *p, *dot;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
302 char brack;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
303
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
304 /* x.dir -> [.x]
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
305 dir:x.dir --> dir:[x]
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
306 dir:[x]y.dir --> dir:[x.y] */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
307 p = in + size;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
308 while (p != in && *p != ':' && *p != '>' && *p != ']') p--;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
309 if (p != in)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
310 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
311 strncpy (out, in, p - in);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
312 out[p - in] = '\0';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
313 if (*p == ':')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
314 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
315 brack = ']';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
316 strcat (out, ":[");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
317 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
318 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
319 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
320 brack = *p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
321 strcat (out, ".");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
322 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
323 p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
324 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
325 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
326 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
327 brack = ']';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
328 strcpy (out, "[.");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
329 }
372
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
330 dot = index (p, '.');
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
331 if (dot)
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
332 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
333 /* blindly remove any extension */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
334 size = strlen (out) + (dot - p);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
335 strncat (out, p, dot - p);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
336 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
337 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
338 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
339 strcat (out, p);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
340 size = strlen (out);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
341 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
342 out[size++] = brack;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
343 out[size] = '\0';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
344 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
345 #else /* not VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
346 /* For Unix syntax, Append a slash if necessary */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
347 if (out[size] != '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
348 strcat (out, "/");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
349 #endif /* not VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
350 return out;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
351 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
352
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
353 DEFUN ("file-name-as-directory", Ffile_name_as_directory,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
354 Sfile_name_as_directory, 1, 1, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
355 "Return a string representing file FILENAME interpreted as a directory.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
356 This operation exists because a directory is also a file, but its name as\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
357 a directory is different from its name as a file.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
358 The result can be used as the value of `default-directory'\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
359 or passed as second argument to `expand-file-name'.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
360 For a Unix-syntax file name, just appends a slash.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
361 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
362 (file)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
363 Lisp_Object file;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
364 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
365 char *buf;
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
366 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
367
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
368 CHECK_STRING (file, 0);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
369 if (NILP (file))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
370 return Qnil;
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
371
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
372 /* If the file name has special constructs in it,
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
373 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
374 handler = Ffind_file_name_handler (file);
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
375 if (!NILP (handler))
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
376 return call2 (handler, Qfile_name_as_directory, file);
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
377
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
378 buf = (char *) alloca (XSTRING (file)->size + 10);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
379 return build_string (file_name_as_directory (buf, XSTRING (file)->data));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
380 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
381
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
382 /*
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
383 * Convert from directory name to filename.
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
384 * On VMS:
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
385 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
386 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
387 * On UNIX, it's simple: just make sure there is a terminating /
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
388
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
389 * Value is nonzero if the string output is different from the input.
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
390 */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
391
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
392 directory_file_name (src, dst)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
393 char *src, *dst;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
394 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
395 long slen;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
396 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
397 long rlen;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
398 char * ptr, * rptr;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
399 char bracket;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
400 struct FAB fab = cc$rms_fab;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
401 struct NAM nam = cc$rms_nam;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
402 char esa[NAM$C_MAXRSS];
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
403 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
404
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
405 slen = strlen (src);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
406 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
407 if (! index (src, '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
408 && (src[slen - 1] == ']'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
409 || src[slen - 1] == ':'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
410 || src[slen - 1] == '>'))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
411 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
412 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
413 fab.fab$l_fna = src;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
414 fab.fab$b_fns = slen;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
415 fab.fab$l_nam = &nam;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
416 fab.fab$l_fop = FAB$M_NAM;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
417
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
418 nam.nam$l_esa = esa;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
419 nam.nam$b_ess = sizeof esa;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
420 nam.nam$b_nop |= NAM$M_SYNCHK;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
421
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
422 /* We call SYS$PARSE to handle such things as [--] for us. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
423 if (SYS$PARSE(&fab, 0, 0) == RMS$_NORMAL)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
424 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
425 slen = nam.nam$b_esl;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
426 if (esa[slen - 1] == ';' && esa[slen - 2] == '.')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
427 slen -= 2;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
428 esa[slen] = '\0';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
429 src = esa;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
430 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
431 if (src[slen - 1] != ']' && src[slen - 1] != '>')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
432 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
433 /* what about when we have logical_name:???? */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
434 if (src[slen - 1] == ':')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
435 { /* Xlate logical name and see what we get */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
436 ptr = strcpy (dst, src); /* upper case for getenv */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
437 while (*ptr)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
438 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
439 if ('a' <= *ptr && *ptr <= 'z')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
440 *ptr -= 040;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
441 ptr++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
442 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
443 dst[slen - 1] = 0; /* remove colon */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
444 if (!(src = egetenv (dst)))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
445 return 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
446 /* should we jump to the beginning of this procedure?
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
447 Good points: allows us to use logical names that xlate
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
448 to Unix names,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
449 Bad points: can be a problem if we just translated to a device
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
450 name...
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
451 For now, I'll punt and always expect VMS names, and hope for
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
452 the best! */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
453 slen = strlen (src);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
454 if (src[slen - 1] != ']' && src[slen - 1] != '>')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
455 { /* no recursion here! */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
456 strcpy (dst, src);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
457 return 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
458 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
459 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
460 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
461 { /* not a directory spec */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
462 strcpy (dst, src);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
463 return 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
464 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
465 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
466 bracket = src[slen - 1];
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
467
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
468 /* If bracket is ']' or '>', bracket - 2 is the corresponding
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
469 opening bracket. */
372
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
470 ptr = index (src, bracket - 2);
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
471 if (ptr == 0)
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
472 { /* no opening bracket */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
473 strcpy (dst, src);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
474 return 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
475 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
476 if (!(rptr = rindex (src, '.')))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
477 rptr = ptr;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
478 slen = rptr - src;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
479 strncpy (dst, src, slen);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
480 dst[slen] = '\0';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
481 if (*rptr == '.')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
482 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
483 dst[slen++] = bracket;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
484 dst[slen] = '\0';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
485 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
486 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
487 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
488 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
489 then translate the device and recurse. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
490 if (dst[slen - 1] == ':'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
491 && dst[slen - 2] != ':' /* skip decnet nodes */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
492 && strcmp(src + slen, "[000000]") == 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
493 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
494 dst[slen - 1] = '\0';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
495 if ((ptr = egetenv (dst))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
496 && (rlen = strlen (ptr) - 1) > 0
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
497 && (ptr[rlen] == ']' || ptr[rlen] == '>')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
498 && ptr[rlen - 1] == '.')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
499 {
1358
aa32c275cbf9 (directory_file_name): Don't clobber the envvar
Richard M. Stallman <rms@gnu.org>
parents: 1299
diff changeset
500 char * buf = (char *) alloca (strlen (ptr) + 1);
aa32c275cbf9 (directory_file_name): Don't clobber the envvar
Richard M. Stallman <rms@gnu.org>
parents: 1299
diff changeset
501 strcpy (buf, ptr);
aa32c275cbf9 (directory_file_name): Don't clobber the envvar
Richard M. Stallman <rms@gnu.org>
parents: 1299
diff changeset
502 buf[rlen - 1] = ']';
aa32c275cbf9 (directory_file_name): Don't clobber the envvar
Richard M. Stallman <rms@gnu.org>
parents: 1299
diff changeset
503 buf[rlen] = '\0';
aa32c275cbf9 (directory_file_name): Don't clobber the envvar
Richard M. Stallman <rms@gnu.org>
parents: 1299
diff changeset
504 return directory_file_name (buf, dst);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
505 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
506 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
507 dst[slen - 1] = ':';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
508 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
509 strcat (dst, "[000000]");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
510 slen += 8;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
511 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
512 rptr++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
513 rlen = strlen (rptr) - 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
514 strncat (dst, rptr, rlen);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
515 dst[slen + rlen] = '\0';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
516 strcat (dst, ".DIR.1");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
517 return 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
518 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
519 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
520 /* Process as Unix format: just remove any final slash.
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
521 But leave "/" unchanged; do not change it to "". */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
522 strcpy (dst, src);
621
eca8812e61cd *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 595
diff changeset
523 if (slen > 1 && dst[slen - 1] == '/')
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
524 dst[slen - 1] = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
525 return 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
526 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
527
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
528 DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
529 1, 1, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
530 "Returns the file name of the directory named DIR.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
531 This is the name of the file that holds the data for the directory DIR.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
532 This operation exists because a directory is also a file, but its name as\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
533 a directory is different from its name as a file.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
534 In Unix-syntax, this function just removes the final slash.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
535 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
536 it returns a file name such as \"[X]Y.DIR.1\".")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
537 (directory)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
538 Lisp_Object directory;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
539 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
540 char *buf;
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
541 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
542
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
543 CHECK_STRING (directory, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
544
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
545 if (NILP (directory))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
546 return Qnil;
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
547
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
548 /* If the file name has special constructs in it,
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
549 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
550 handler = Ffind_file_name_handler (directory);
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
551 if (!NILP (handler))
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
552 return call2 (handler, Qdirectory_file_name, directory);
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
553
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
554 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
555 /* 20 extra chars is insufficient for VMS, since we might perform a
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
556 logical name translation. an equivalence string can be up to 255
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
557 chars long, so grab that much extra space... - sss */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
558 buf = (char *) alloca (XSTRING (directory)->size + 20 + 255);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
559 #else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
560 buf = (char *) alloca (XSTRING (directory)->size + 20);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
561 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
562 directory_file_name (XSTRING (directory)->data, buf);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
563 return build_string (buf);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
564 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
565
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
566 DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
567 "Generate temporary file name (string) starting with PREFIX (a string).\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
568 The Emacs process number forms part of the result,\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
569 so there is no danger of generating a name being used by another process.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
570 (prefix)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
571 Lisp_Object prefix;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
572 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
573 Lisp_Object val;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
574 val = concat2 (prefix, build_string ("XXXXXX"));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
575 mktemp (XSTRING (val)->data);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
576 return val;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
577 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
578
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
579 DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
580 "Convert FILENAME to absolute, and canonicalize it.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
581 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
582 (does not start with slash); if DEFAULT is nil or missing,\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
583 the current buffer's value of default-directory is used.\n\
536
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
584 Path components that are `.' are removed, and \n\
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
585 path components followed by `..' are removed, along with the `..' itself;\n\
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
586 note that these simplifications are done without checking the resulting\n\
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
587 paths in the file system.\n\
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
588 An initial `~/' expands to your home directory.\n\
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
589 An initial `~USER/' expands to USER's home directory.\n\
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
590 See also the function `substitute-in-file-name'.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
591 (name, defalt)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
592 Lisp_Object name, defalt;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
593 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
594 unsigned char *nm;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
595
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
596 register unsigned char *newdir, *p, *o;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
597 int tlen;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
598 unsigned char *target;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
599 struct passwd *pw;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
600 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
601 unsigned char * colon = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
602 unsigned char * close = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
603 unsigned char * slash = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
604 unsigned char * brack = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
605 int lbrack = 0, rbrack = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
606 int dots = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
607 #endif /* VMS */
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
608 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
609
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
610 CHECK_STRING (name, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
611
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
612 /* If the file name has special constructs in it,
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
613 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
614 handler = Ffind_file_name_handler (name);
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
615 if (!NILP (handler))
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
616 return call3 (handler, Qexpand_file_name, name, defalt);
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
617
1869
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
618 /* Make sure DEFALT is properly expanded.
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
619 It would be better to do this down below where we actually use
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
620 defalt. Unfortunately, calling Fexpand_file_name recursively
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
621 could invoke GC, and the strings might be relocated. This would
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
622 be annoying because we have pointers into strings lying around
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
623 that would need adjusting, and people would add new pointers to
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
624 the code and forget to adjust them, resulting in intermittent bugs.
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
625 Putting this call here avoids all that crud. */
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
626 if (! NILP (defalt))
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
627 {
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
628 struct gcpro gcpro1;
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
629
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
630 GCPRO1 (name);
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
631 defalt = Fexpand_file_name (defalt, Qnil);
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
632 UNGCPRO;
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
633 }
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
634
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
635 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
636 /* Filenames on VMS are always upper case. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
637 name = Fupcase (name);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
638 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
639
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
640 nm = XSTRING (name)->data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
641
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
642 /* If nm is absolute, flush ...// and detect /./ and /../.
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
643 If no /./ or /../ we can return right away. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
644 if (
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
645 nm[0] == '/'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
646 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
647 || index (nm, ':')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
648 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
649 )
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
650 {
1869
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
651 /* If it turns out that the filename we want to return is just a
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
652 suffix of FILENAME, we don't need to go through and edit
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
653 things; we just need to construct a new string using data
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
654 starting at the middle of FILENAME. If we set lose to a
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
655 non-zero value, that means we've discovered that we can't do
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
656 that cool trick. */
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
657 int lose = 0;
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
658
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
659 p = nm;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
660 while (*p)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
661 {
1589
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
662 /* Since we know the path is absolute, we can assume that each
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
663 element starts with a "/". */
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
664
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
665 /* "//" anywhere isn't necessarily hairy; we just start afresh
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
666 with the second slash. */
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
667 if (p[0] == '/' && p[1] == '/'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
668 #ifdef APOLLO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
669 /* // at start of filename is meaningful on Apollo system */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
670 && nm != p
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
671 #endif /* APOLLO */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
672 )
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
673 nm = p + 1;
1589
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
674
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
675 /* "~" is hairy as the start of any path element. */
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
676 if (p[0] == '/' && p[1] == '~')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
677 nm = p + 1, lose = 1;
1589
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
678
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
679 /* "." and ".." are hairy. */
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
680 if (p[0] == '/'
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
681 && p[1] == '.'
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
682 && (p[2] == '/'
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
683 || p[2] == 0
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
684 || (p[2] == '.' && (p[3] == '/'
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
685 || p[3] == 0))))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
686 lose = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
687 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
688 if (p[0] == '\\')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
689 lose = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
690 if (p[0] == '/') {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
691 /* if dev:[dir]/, move nm to / */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
692 if (!slash && p > nm && (brack || colon)) {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
693 nm = (brack ? brack + 1 : colon + 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
694 lbrack = rbrack = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
695 brack = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
696 colon = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
697 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
698 slash = p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
699 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
700 if (p[0] == '-')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
701 #ifndef VMS4_4
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
702 /* VMS pre V4.4,convert '-'s in filenames. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
703 if (lbrack == rbrack)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
704 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
705 if (dots < 2) /* this is to allow negative version numbers */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
706 p[0] = '_';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
707 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
708 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
709 #endif /* VMS4_4 */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
710 if (lbrack > rbrack &&
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
711 ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') &&
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
712 (p[1] == '.' || p[1] == ']' || p[1] == '>')))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
713 lose = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
714 #ifndef VMS4_4
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
715 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
716 p[0] = '_';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
717 #endif /* VMS4_4 */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
718 /* count open brackets, reset close bracket pointer */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
719 if (p[0] == '[' || p[0] == '<')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
720 lbrack++, brack = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
721 /* count close brackets, set close bracket pointer */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
722 if (p[0] == ']' || p[0] == '>')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
723 rbrack++, brack = p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
724 /* detect ][ or >< */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
725 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
726 lose = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
727 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
728 nm = p + 1, lose = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
729 if (p[0] == ':' && (colon || slash))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
730 /* if dev1:[dir]dev2:, move nm to dev2: */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
731 if (brack)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
732 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
733 nm = brack + 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
734 brack = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
735 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
736 /* if /pathname/dev:, move nm to dev: */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
737 else if (slash)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
738 nm = slash + 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
739 /* if node::dev:, move colon following dev */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
740 else if (colon && colon[-1] == ':')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
741 colon = p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
742 /* if dev1:dev2:, move nm to dev2: */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
743 else if (colon && colon[-1] != ':')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
744 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
745 nm = colon + 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
746 colon = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
747 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
748 if (p[0] == ':' && !colon)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
749 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
750 if (p[1] == ':')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
751 p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
752 colon = p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
753 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
754 if (lbrack == rbrack)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
755 if (p[0] == ';')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
756 dots = 2;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
757 else if (p[0] == '.')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
758 dots++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
759 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
760 p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
761 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
762 if (!lose)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
763 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
764 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
765 if (index (nm, '/'))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
766 return build_string (sys_translate_unix (nm));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
767 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
768 if (nm == XSTRING (name)->data)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
769 return name;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
770 return build_string (nm);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
771 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
772 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
773
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
774 /* Now determine directory to start with and put it in newdir */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
775
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
776 newdir = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
777
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
778 if (nm[0] == '~') /* prefix ~ */
1589
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
779 {
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
780 if (nm[1] == '/'
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
781 #ifdef VMS
1589
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
782 || nm[1] == ':'
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
783 #endif /* VMS */
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
784 || nm[1] == 0) /* ~ by itself */
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
785 {
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
786 if (!(newdir = (unsigned char *) egetenv ("HOME")))
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
787 newdir = (unsigned char *) "";
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
788 nm++;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
789 #ifdef VMS
1589
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
790 nm++; /* Don't leave the slash in nm. */
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
791 #endif /* VMS */
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
792 }
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
793 else /* ~user/filename */
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
794 {
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
795 for (p = nm; *p && (*p != '/'
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
796 #ifdef VMS
1589
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
797 && *p != ':'
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
798 #endif /* VMS */
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
799 ); p++);
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
800 o = (unsigned char *) alloca (p - nm + 1);
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
801 bcopy ((char *) nm, o, p - nm);
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
802 o [p - nm] = 0;
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
803
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
804 pw = (struct passwd *) getpwnam (o + 1);
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
805 if (pw)
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
806 {
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
807 newdir = (unsigned char *) pw -> pw_dir;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
808 #ifdef VMS
1589
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
809 nm = p + 1; /* skip the terminator */
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
810 #else
1589
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
811 nm = p;
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
812 #endif /* VMS */
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
813 }
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
814
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
815 /* If we don't find a user of that name, leave the name
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
816 unchanged; don't move nm forward to p. */
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
817 }
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
818 }
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
819
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
820 if (nm[0] != '/'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
821 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
822 && !index (nm, ':')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
823 #endif /* not VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
824 && !newdir)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
825 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
826 if (NILP (defalt))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
827 defalt = current_buffer->directory;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
828 CHECK_STRING (defalt, 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
829 newdir = XSTRING (defalt)->data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
830 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
831
372
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
832 if (newdir != 0)
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
833 {
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
834 /* Get rid of any slash at the end of newdir. */
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
835 int length = strlen (newdir);
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
836 if (newdir[length - 1] == '/')
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
837 {
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
838 unsigned char *temp = (unsigned char *) alloca (length);
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
839 bcopy (newdir, temp, length - 1);
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
840 temp[length - 1] = 0;
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
841 newdir = temp;
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
842 }
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
843 tlen = length + 1;
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
844 }
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
845 else
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
846 tlen = 0;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
847
372
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
848 /* Now concatenate the directory and name to new space in the stack frame */
481e29c1e27e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 350
diff changeset
849 tlen += strlen (nm) + 1;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
850 target = (unsigned char *) alloca (tlen);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
851 *target = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
852
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
853 if (newdir)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
854 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
855 #ifndef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
856 if (nm[0] == 0 || nm[0] == '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
857 strcpy (target, newdir);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
858 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
859 #endif
1589
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
860 file_name_as_directory (target, newdir);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
861 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
862
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
863 strcat (target, nm);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
864 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
865 if (index (target, '/'))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
866 strcpy (target, sys_translate_unix (target));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
867 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
868
1589
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
869 /* Now canonicalize by removing /. and /foo/.. if they appear. */
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
870
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
871 p = target;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
872 o = target;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
873
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
874 while (*p)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
875 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
876 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
877 if (*p != ']' && *p != '>' && *p != '-')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
878 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
879 if (*p == '\\')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
880 p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
881 *o++ = *p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
882 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
883 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
884 /* brackets are offset from each other by 2 */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
885 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
886 p += 2;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
887 if (*p != '.' && *p != '-' && o[-1] != '.')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
888 /* convert [foo][bar] to [bar] */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
889 while (o[-1] != '[' && o[-1] != '<')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
890 o--;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
891 else if (*p == '-' && *o != '.')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
892 *--p = '.';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
893 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
894 else if (p[0] == '-' && o[-1] == '.' &&
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
895 (p[1] == '.' || p[1] == ']' || p[1] == '>'))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
896 /* flush .foo.- ; leave - if stopped by '[' or '<' */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
897 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
898 do
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
899 o--;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
900 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
901 if (p[1] == '.') /* foo.-.bar ==> bar*/
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
902 p += 2;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
903 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
904 p++, o--;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
905 /* else [foo.-] ==> [-] */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
906 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
907 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
908 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
909 #ifndef VMS4_4
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
910 if (*p == '-' &&
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
911 o[-1] != '[' && o[-1] != '<' && o[-1] != '.' &&
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
912 p[1] != ']' && p[1] != '>' && p[1] != '.')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
913 *p = '_';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
914 #endif /* VMS4_4 */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
915 *o++ = *p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
916 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
917 #else /* not VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
918 if (*p != '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
919 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
920 *o++ = *p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
921 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
922 else if (!strncmp (p, "//", 2)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
923 #ifdef APOLLO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
924 /* // at start of filename is meaningful in Apollo system */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
925 && o != target
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
926 #endif /* APOLLO */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
927 )
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
928 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
929 o = target;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
930 p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
931 }
1589
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
932 else if (p[0] == '/'
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
933 && p[1] == '.'
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
934 && (p[2] == '/'
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
935 || p[2] == 0))
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
936 {
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
937 /* If "/." is the entire filename, keep the "/". Otherwise,
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
938 just delete the whole "/.". */
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
939 if (o == target && p[2] == '\0')
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
940 *o++ = *p;
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
941 p += 2;
6168f42d716c * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents: 1536
diff changeset
942 }
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
943 else if (!strncmp (p, "/..", 3)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
944 /* `/../' is the "superroot" on certain file systems. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
945 && o != target
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
946 && (p[3] == '/' || p[3] == 0))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
947 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
948 while (o != target && *--o != '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
949 ;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
950 #ifdef APOLLO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
951 if (o == target + 1 && o[-1] == '/' && o[0] == '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
952 ++o;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
953 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
954 #endif /* APOLLO */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
955 if (o == target && *o == '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
956 ++o;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
957 p += 3;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
958 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
959 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
960 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
961 *o++ = *p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
962 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
963 #endif /* not VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
964 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
965
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
966 return make_string (target, o - target);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
967 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
968 #if 0
732
a8d94735277e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 689
diff changeset
969 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
a8d94735277e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 689
diff changeset
970 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
971 "Convert FILENAME to absolute, and canonicalize it.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
972 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
973 (does not start with slash); if DEFAULT is nil or missing,\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
974 the current buffer's value of default-directory is used.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
975 Filenames containing `.' or `..' as components are simplified;\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
976 initial `~/' expands to your home directory.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
977 See also the function `substitute-in-file-name'.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
978 (name, defalt)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
979 Lisp_Object name, defalt;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
980 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
981 unsigned char *nm;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
982
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
983 register unsigned char *newdir, *p, *o;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
984 int tlen;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
985 unsigned char *target;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
986 struct passwd *pw;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
987 int lose;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
988 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
989 unsigned char * colon = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
990 unsigned char * close = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
991 unsigned char * slash = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
992 unsigned char * brack = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
993 int lbrack = 0, rbrack = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
994 int dots = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
995 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
996
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
997 CHECK_STRING (name, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
998
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
999 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1000 /* Filenames on VMS are always upper case. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1001 name = Fupcase (name);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1002 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1003
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1004 nm = XSTRING (name)->data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1005
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1006 /* If nm is absolute, flush ...// and detect /./ and /../.
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1007 If no /./ or /../ we can return right away. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1008 if (
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1009 nm[0] == '/'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1010 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1011 || index (nm, ':')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1012 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1013 )
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1014 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1015 p = nm;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1016 lose = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1017 while (*p)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1018 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1019 if (p[0] == '/' && p[1] == '/'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1020 #ifdef APOLLO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1021 /* // at start of filename is meaningful on Apollo system */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1022 && nm != p
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1023 #endif /* APOLLO */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1024 )
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1025 nm = p + 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1026 if (p[0] == '/' && p[1] == '~')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1027 nm = p + 1, lose = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1028 if (p[0] == '/' && p[1] == '.'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1029 && (p[2] == '/' || p[2] == 0
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1030 || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1031 lose = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1032 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1033 if (p[0] == '\\')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1034 lose = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1035 if (p[0] == '/') {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1036 /* if dev:[dir]/, move nm to / */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1037 if (!slash && p > nm && (brack || colon)) {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1038 nm = (brack ? brack + 1 : colon + 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1039 lbrack = rbrack = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1040 brack = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1041 colon = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1042 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1043 slash = p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1044 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1045 if (p[0] == '-')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1046 #ifndef VMS4_4
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1047 /* VMS pre V4.4,convert '-'s in filenames. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1048 if (lbrack == rbrack)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1049 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1050 if (dots < 2) /* this is to allow negative version numbers */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1051 p[0] = '_';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1052 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1053 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1054 #endif /* VMS4_4 */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1055 if (lbrack > rbrack &&
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1056 ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') &&
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1057 (p[1] == '.' || p[1] == ']' || p[1] == '>')))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1058 lose = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1059 #ifndef VMS4_4
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1060 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1061 p[0] = '_';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1062 #endif /* VMS4_4 */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1063 /* count open brackets, reset close bracket pointer */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1064 if (p[0] == '[' || p[0] == '<')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1065 lbrack++, brack = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1066 /* count close brackets, set close bracket pointer */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1067 if (p[0] == ']' || p[0] == '>')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1068 rbrack++, brack = p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1069 /* detect ][ or >< */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1070 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1071 lose = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1072 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1073 nm = p + 1, lose = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1074 if (p[0] == ':' && (colon || slash))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1075 /* if dev1:[dir]dev2:, move nm to dev2: */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1076 if (brack)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1077 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1078 nm = brack + 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1079 brack = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1080 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1081 /* if /pathname/dev:, move nm to dev: */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1082 else if (slash)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1083 nm = slash + 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1084 /* if node::dev:, move colon following dev */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1085 else if (colon && colon[-1] == ':')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1086 colon = p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1087 /* if dev1:dev2:, move nm to dev2: */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1088 else if (colon && colon[-1] != ':')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1089 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1090 nm = colon + 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1091 colon = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1092 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1093 if (p[0] == ':' && !colon)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1094 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1095 if (p[1] == ':')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1096 p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1097 colon = p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1098 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1099 if (lbrack == rbrack)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1100 if (p[0] == ';')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1101 dots = 2;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1102 else if (p[0] == '.')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1103 dots++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1104 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1105 p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1106 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1107 if (!lose)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1108 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1109 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1110 if (index (nm, '/'))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1111 return build_string (sys_translate_unix (nm));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1112 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1113 if (nm == XSTRING (name)->data)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1114 return name;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1115 return build_string (nm);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1116 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1117 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1118
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1119 /* Now determine directory to start with and put it in NEWDIR */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1120
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1121 newdir = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1122
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1123 if (nm[0] == '~') /* prefix ~ */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1124 if (nm[1] == '/'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1125 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1126 || nm[1] == ':'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1127 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1128 || nm[1] == 0)/* ~/filename */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1129 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1130 if (!(newdir = (unsigned char *) egetenv ("HOME")))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1131 newdir = (unsigned char *) "";
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1132 nm++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1133 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1134 nm++; /* Don't leave the slash in nm. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1135 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1136 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1137 else /* ~user/filename */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1138 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1139 /* Get past ~ to user */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1140 unsigned char *user = nm + 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1141 /* Find end of name. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1142 unsigned char *ptr = (unsigned char *) index (user, '/');
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1143 int len = ptr ? ptr - user : strlen (user);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1144 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1145 unsigned char *ptr1 = index (user, ':');
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1146 if (ptr1 != 0 && ptr1 - user < len)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1147 len = ptr1 - user;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1148 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1149 /* Copy the user name into temp storage. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1150 o = (unsigned char *) alloca (len + 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1151 bcopy ((char *) user, o, len);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1152 o[len] = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1153
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1154 /* Look up the user name. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1155 pw = (struct passwd *) getpwnam (o + 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1156 if (!pw)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1157 error ("\"%s\" isn't a registered user", o + 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1158
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1159 newdir = (unsigned char *) pw->pw_dir;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1160
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1161 /* Discard the user name from NM. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1162 nm += len;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1163 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1164
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1165 if (nm[0] != '/'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1166 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1167 && !index (nm, ':')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1168 #endif /* not VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1169 && !newdir)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1170 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
1171 if (NILP (defalt))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1172 defalt = current_buffer->directory;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1173 CHECK_STRING (defalt, 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1174 newdir = XSTRING (defalt)->data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1175 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1176
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1177 /* Now concatenate the directory and name to new space in the stack frame */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1178
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1179 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1180 target = (unsigned char *) alloca (tlen);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1181 *target = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1182
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1183 if (newdir)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1184 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1185 #ifndef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1186 if (nm[0] == 0 || nm[0] == '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1187 strcpy (target, newdir);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1188 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1189 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1190 file_name_as_directory (target, newdir);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1191 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1192
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1193 strcat (target, nm);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1194 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1195 if (index (target, '/'))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1196 strcpy (target, sys_translate_unix (target));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1197 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1198
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1199 /* Now canonicalize by removing /. and /foo/.. if they appear */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1200
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1201 p = target;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1202 o = target;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1203
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1204 while (*p)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1205 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1206 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1207 if (*p != ']' && *p != '>' && *p != '-')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1208 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1209 if (*p == '\\')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1210 p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1211 *o++ = *p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1212 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1213 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1214 /* brackets are offset from each other by 2 */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1215 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1216 p += 2;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1217 if (*p != '.' && *p != '-' && o[-1] != '.')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1218 /* convert [foo][bar] to [bar] */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1219 while (o[-1] != '[' && o[-1] != '<')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1220 o--;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1221 else if (*p == '-' && *o != '.')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1222 *--p = '.';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1223 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1224 else if (p[0] == '-' && o[-1] == '.' &&
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1225 (p[1] == '.' || p[1] == ']' || p[1] == '>'))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1226 /* flush .foo.- ; leave - if stopped by '[' or '<' */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1227 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1228 do
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1229 o--;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1230 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1231 if (p[1] == '.') /* foo.-.bar ==> bar*/
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1232 p += 2;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1233 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1234 p++, o--;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1235 /* else [foo.-] ==> [-] */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1236 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1237 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1238 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1239 #ifndef VMS4_4
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1240 if (*p == '-' &&
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1241 o[-1] != '[' && o[-1] != '<' && o[-1] != '.' &&
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1242 p[1] != ']' && p[1] != '>' && p[1] != '.')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1243 *p = '_';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1244 #endif /* VMS4_4 */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1245 *o++ = *p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1246 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1247 #else /* not VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1248 if (*p != '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1249 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1250 *o++ = *p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1251 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1252 else if (!strncmp (p, "//", 2)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1253 #ifdef APOLLO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1254 /* // at start of filename is meaningful in Apollo system */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1255 && o != target
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1256 #endif /* APOLLO */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1257 )
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1258 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1259 o = target;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1260 p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1261 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1262 else if (p[0] == '/' && p[1] == '.' &&
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1263 (p[2] == '/' || p[2] == 0))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1264 p += 2;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1265 else if (!strncmp (p, "/..", 3)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1266 /* `/../' is the "superroot" on certain file systems. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1267 && o != target
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1268 && (p[3] == '/' || p[3] == 0))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1269 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1270 while (o != target && *--o != '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1271 ;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1272 #ifdef APOLLO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1273 if (o == target + 1 && o[-1] == '/' && o[0] == '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1274 ++o;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1275 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1276 #endif /* APOLLO */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1277 if (o == target && *o == '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1278 ++o;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1279 p += 3;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1280 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1281 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1282 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1283 *o++ = *p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1284 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1285 #endif /* not VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1286 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1287
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1288 return make_string (target, o - target);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1289 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1290 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1291
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1292 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1293 Ssubstitute_in_file_name, 1, 1, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1294 "Substitute environment variables referred to in FILENAME.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1295 `$FOO' where FOO is an environment variable name means to substitute\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1296 the value of that variable. The variable name should be terminated\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1297 with a character not a letter, digit or underscore; otherwise, enclose\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1298 the entire variable name in braces.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1299 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1300 On VMS, `$' substitution is not done; this function does little and only\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1301 duplicates what `expand-file-name' does.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1302 (string)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1303 Lisp_Object string;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1304 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1305 unsigned char *nm;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1306
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1307 register unsigned char *s, *p, *o, *x, *endp;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1308 unsigned char *target;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1309 int total = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1310 int substituted = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1311 unsigned char *xnm;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1312
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1313 CHECK_STRING (string, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1314
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1315 nm = XSTRING (string)->data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1316 endp = nm + XSTRING (string)->size;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1317
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1318 /* If /~ or // appears, discard everything through first slash. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1319
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1320 for (p = nm; p != endp; p++)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1321 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1322 if ((p[0] == '~' ||
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1323 #ifdef APOLLO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1324 /* // at start of file name is meaningful in Apollo system */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1325 (p[0] == '/' && p - 1 != nm)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1326 #else /* not APOLLO */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1327 p[0] == '/'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1328 #endif /* not APOLLO */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1329 )
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1330 && p != nm &&
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1331 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1332 (p[-1] == ':' || p[-1] == ']' || p[-1] == '>' ||
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1333 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1334 p[-1] == '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1335 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1336 )
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1337 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1338 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1339 nm = p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1340 substituted = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1341 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1342 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1343
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1344 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1345 return build_string (nm);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1346 #else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1347
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1348 /* See if any variables are substituted into the string
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1349 and find the total length of their values in `total' */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1350
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1351 for (p = nm; p != endp;)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1352 if (*p != '$')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1353 p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1354 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1355 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1356 p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1357 if (p == endp)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1358 goto badsubst;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1359 else if (*p == '$')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1360 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1361 /* "$$" means a single "$" */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1362 p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1363 total -= 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1364 substituted = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1365 continue;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1366 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1367 else if (*p == '{')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1368 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1369 o = ++p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1370 while (p != endp && *p != '}') p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1371 if (*p != '}') goto missingclose;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1372 s = p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1373 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1374 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1375 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1376 o = p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1377 while (p != endp && (isalnum (*p) || *p == '_')) p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1378 s = p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1379 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1380
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1381 /* Copy out the variable name */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1382 target = (unsigned char *) alloca (s - o + 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1383 strncpy (target, o, s - o);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1384 target[s - o] = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1385
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1386 /* Get variable value */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1387 o = (unsigned char *) egetenv (target);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1388 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1389 #if 0
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1390 #ifdef USG
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1391 if (!o && !strcmp (target, "USER"))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1392 o = egetenv ("LOGNAME");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1393 #endif /* USG */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1394 #endif /* 0 */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1395 if (!o) goto badvar;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1396 total += strlen (o);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1397 substituted = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1398 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1399
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1400 if (!substituted)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1401 return string;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1402
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1403 /* If substitution required, recopy the string and do it */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1404 /* Make space in stack frame for the new copy */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1405 xnm = (unsigned char *) alloca (XSTRING (string)->size + total + 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1406 x = xnm;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1407
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1408 /* Copy the rest of the name through, replacing $ constructs with values */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1409 for (p = nm; *p;)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1410 if (*p != '$')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1411 *x++ = *p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1412 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1413 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1414 p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1415 if (p == endp)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1416 goto badsubst;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1417 else if (*p == '$')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1418 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1419 *x++ = *p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1420 continue;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1421 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1422 else if (*p == '{')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1423 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1424 o = ++p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1425 while (p != endp && *p != '}') p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1426 if (*p != '}') goto missingclose;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1427 s = p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1428 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1429 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1430 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1431 o = p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1432 while (p != endp && (isalnum (*p) || *p == '_')) p++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1433 s = p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1434 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1435
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1436 /* Copy out the variable name */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1437 target = (unsigned char *) alloca (s - o + 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1438 strncpy (target, o, s - o);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1439 target[s - o] = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1440
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1441 /* Get variable value */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1442 o = (unsigned char *) egetenv (target);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1443 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1444 #if 0
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1445 #ifdef USG
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1446 if (!o && !strcmp (target, "USER"))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1447 o = egetenv ("LOGNAME");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1448 #endif /* USG */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1449 #endif /* 0 */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1450 if (!o)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1451 goto badvar;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1452
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1453 strcpy (x, o);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1454 x += strlen (o);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1455 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1456
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1457 *x = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1458
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1459 /* If /~ or // appears, discard everything through first slash. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1460
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1461 for (p = xnm; p != x; p++)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1462 if ((p[0] == '~' ||
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1463 #ifdef APOLLO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1464 /* // at start of file name is meaningful in Apollo system */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1465 (p[0] == '/' && p - 1 != xnm)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1466 #else /* not APOLLO */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1467 p[0] == '/'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1468 #endif /* not APOLLO */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1469 )
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1470 && p != nm && p[-1] == '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1471 xnm = p;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1472
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1473 return make_string (xnm, x - xnm);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1474
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1475 badsubst:
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1476 error ("Bad format environment-variable substitution");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1477 missingclose:
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1478 error ("Missing \"}\" in environment-variable substitution");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1479 badvar:
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1480 error ("Substituting nonexistent environment variable \"%s\"", target);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1481
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1482 /* NOTREACHED */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1483 #endif /* not VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1484 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1485
853
224b0d5d1a38 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 850
diff changeset
1486 /* A slightly faster and more convenient way to get
224b0d5d1a38 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 850
diff changeset
1487 (directory-file-name (expand-file-name FOO)). The return value may
224b0d5d1a38 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 850
diff changeset
1488 have had its last character zapped with a '\0' character, meaning
224b0d5d1a38 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 850
diff changeset
1489 that it is acceptable to system calls, but not to other lisp
224b0d5d1a38 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 850
diff changeset
1490 functions. Callers should make sure that the return value doesn't
224b0d5d1a38 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 850
diff changeset
1491 escape. */
224b0d5d1a38 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 850
diff changeset
1492
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1493 Lisp_Object
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1494 expand_and_dir_to_file (filename, defdir)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1495 Lisp_Object filename, defdir;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1496 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1497 register Lisp_Object abspath;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1498
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1499 abspath = Fexpand_file_name (filename, defdir);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1500 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1501 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1502 register int c = XSTRING (abspath)->data[XSTRING (abspath)->size - 1];
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1503 if (c == ':' || c == ']' || c == '>')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1504 abspath = Fdirectory_file_name (abspath);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1505 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1506 #else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1507 /* Remove final slash, if any (unless path is root).
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1508 stat behaves differently depending! */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1509 if (XSTRING (abspath)->size > 1
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1510 && XSTRING (abspath)->data[XSTRING (abspath)->size - 1] == '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1511 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1512 if (EQ (abspath, filename))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1513 abspath = Fcopy_sequence (abspath);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1514 XSTRING (abspath)->data[XSTRING (abspath)->size - 1] = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1515 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1516 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1517 return abspath;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1518 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1519
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1520 barf_or_query_if_file_exists (absname, querystring, interactive)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1521 Lisp_Object absname;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1522 unsigned char *querystring;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1523 int interactive;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1524 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1525 register Lisp_Object tem;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1526 struct gcpro gcpro1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1527
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1528 if (access (XSTRING (absname)->data, 4) >= 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1529 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1530 if (! interactive)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1531 Fsignal (Qfile_already_exists,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1532 Fcons (build_string ("File already exists"),
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1533 Fcons (absname, Qnil)));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1534 GCPRO1 (absname);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1535 tem = do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1536 XSTRING (absname)->data, querystring));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1537 UNGCPRO;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
1538 if (NILP (tem))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1539 Fsignal (Qfile_already_exists,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1540 Fcons (build_string ("File already exists"),
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1541 Fcons (absname, Qnil)));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1542 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1543 return;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1544 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1545
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1546 DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4,
410
7812e9efc1af *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 372
diff changeset
1547 "fCopy file: \nFCopy %s to file: \np\nP",
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1548 "Copy FILE to NEWNAME. Both args must be strings.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1549 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1550 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1551 A number as third arg means request confirmation if NEWNAME already exists.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1552 This is what happens in interactive use with M-x.\n\
410
7812e9efc1af *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 372
diff changeset
1553 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
7812e9efc1af *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 372
diff changeset
1554 last-modified time as the old one. (This works on only some systems.)\n\
7812e9efc1af *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 372
diff changeset
1555 A prefix arg makes KEEP-TIME non-nil.")
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1556 (filename, newname, ok_if_already_exists, keep_date)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1557 Lisp_Object filename, newname, ok_if_already_exists, keep_date;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1558 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1559 int ifd, ofd, n;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1560 char buf[16 * 1024];
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1561 struct stat st;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1562 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1563 struct gcpro gcpro1, gcpro2;
592
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
1564 int count = specpdl_ptr - specpdl;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1565
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1566 GCPRO2 (filename, newname);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1567 CHECK_STRING (filename, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1568 CHECK_STRING (newname, 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1569 filename = Fexpand_file_name (filename, Qnil);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1570 newname = Fexpand_file_name (newname, Qnil);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1571
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
1572 /* If the input file name has special constructs in it,
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1573 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
1574 handler = Ffind_file_name_handler (filename);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1575 if (!NILP (handler))
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1576 return call3 (handler, Qcopy_file, filename, newname);
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
1577 /* Likewise for output file name. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
1578 handler = Ffind_file_name_handler (newname);
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
1579 if (!NILP (handler))
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
1580 return call3 (handler, Qcopy_file, filename, newname);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1581
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
1582 if (NILP (ok_if_already_exists)
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1583 || XTYPE (ok_if_already_exists) == Lisp_Int)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1584 barf_or_query_if_file_exists (newname, "copy to it",
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1585 XTYPE (ok_if_already_exists) == Lisp_Int);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1586
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1587 ifd = open (XSTRING (filename)->data, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1588 if (ifd < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1589 report_file_error ("Opening input file", Fcons (filename, Qnil));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1590
592
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
1591 record_unwind_protect (close_file_unwind, make_number (ifd));
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
1592
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1593 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1594 /* Create the copy file with the same record format as the input file */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1595 ofd = sys_creat (XSTRING (newname)->data, 0666, ifd);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1596 #else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1597 ofd = creat (XSTRING (newname)->data, 0666);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1598 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1599 if (ofd < 0)
595
114b502d0822 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 592
diff changeset
1600 report_file_error ("Opening output file", Fcons (newname, Qnil));
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1601
592
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
1602 record_unwind_protect (close_file_unwind, make_number (ofd));
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
1603
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
1604 immediate_quit = 1;
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
1605 QUIT;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1606 while ((n = read (ifd, buf, sizeof buf)) > 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1607 if (write (ofd, buf, n) != n)
595
114b502d0822 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 592
diff changeset
1608 report_file_error ("I/O error", Fcons (newname, Qnil));
592
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
1609 immediate_quit = 0;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1610
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1611 if (fstat (ifd, &st) >= 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1612 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
1613 if (!NILP (keep_date))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1614 {
564
d909f2be7ee1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 550
diff changeset
1615 EMACS_TIME atime, mtime;
d909f2be7ee1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 550
diff changeset
1616 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
d909f2be7ee1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 550
diff changeset
1617 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
d909f2be7ee1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 550
diff changeset
1618 EMACS_SET_UTIMES (XSTRING (newname)->data, atime, mtime);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1619 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1620 #ifdef APOLLO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1621 if (!egetenv ("USE_DOMAIN_ACLS"))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1622 #endif
564
d909f2be7ee1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 550
diff changeset
1623 chmod (XSTRING (newname)->data, st.st_mode & 07777);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1624 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1625
592
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
1626 /* Discard the unwind protects. */
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
1627 specpdl_ptr = specpdl + count;
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
1628
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1629 close (ifd);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1630 if (close (ofd) < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1631 report_file_error ("I/O error", Fcons (newname, Qnil));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1632
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1633 UNGCPRO;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1634 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1635 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1636
1533
b86ef0432100 (Fmake_directory_internal): Renamed from Fmake_directory.
Richard M. Stallman <rms@gnu.org>
parents: 1377
diff changeset
1637 DEFUN ("make-directory-internal", Fmake_directory_internal,
1536
0877009e6324 * fileio.c (Fmake_directory_internal): Remove extra paren before the
Jim Blandy <jimb@redhat.com>
parents: 1533
diff changeset
1638 Smake_directory_internal, 1, 1, 0,
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1639 "Create a directory. One argument, a file name string.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1640 (dirname)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1641 Lisp_Object dirname;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1642 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1643 unsigned char *dir;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1644 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1645
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1646 CHECK_STRING (dirname, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1647 dirname = Fexpand_file_name (dirname, Qnil);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1648
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
1649 handler = Ffind_file_name_handler (dirname);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1650 if (!NILP (handler))
1533
b86ef0432100 (Fmake_directory_internal): Renamed from Fmake_directory.
Richard M. Stallman <rms@gnu.org>
parents: 1377
diff changeset
1651 return call3 (handler, Qmake_directory, dirname, Qnil);
b86ef0432100 (Fmake_directory_internal): Renamed from Fmake_directory.
Richard M. Stallman <rms@gnu.org>
parents: 1377
diff changeset
1652
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1653 dir = XSTRING (dirname)->data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1654
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1655 if (mkdir (dir, 0777) != 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1656 report_file_error ("Creating directory", Flist (1, &dirname));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1657
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1658 return Qnil;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1659 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1660
686
bd3068742807 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
1661 DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",
bd3068742807 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
1662 "Delete a directory. One argument, a file name string.")
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1663 (dirname)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1664 Lisp_Object dirname;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1665 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1666 unsigned char *dir;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1667 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1668
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1669 CHECK_STRING (dirname, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1670 dirname = Fexpand_file_name (dirname, Qnil);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1671 dir = XSTRING (dirname)->data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1672
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
1673 handler = Ffind_file_name_handler (dirname);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1674 if (!NILP (handler))
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1675 return call2 (handler, Qdelete_directory, dirname);
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1676
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1677 if (rmdir (dir) != 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1678 report_file_error ("Removing directory", Flist (1, &dirname));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1679
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1680 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1681 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1682
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1683 DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1684 "Delete specified file. One argument, a file name string.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1685 If file has multiple names, it continues to exist with the other names.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1686 (filename)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1687 Lisp_Object filename;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1688 {
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1689 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1690 CHECK_STRING (filename, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1691 filename = Fexpand_file_name (filename, Qnil);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1692
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
1693 handler = Ffind_file_name_handler (filename);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1694 if (!NILP (handler))
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1695 return call2 (handler, Qdelete_file, filename);
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1696
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1697 if (0 > unlink (XSTRING (filename)->data))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1698 report_file_error ("Removing old name", Flist (1, &filename));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1699 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1700 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1701
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1702 DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1703 "fRename file: \nFRename %s to file: \np",
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1704 "Rename FILE as NEWNAME. Both args strings.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1705 If file has names other than FILE, it continues to have those names.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1706 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1707 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1708 A number as third arg means request confirmation if NEWNAME already exists.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1709 This is what happens in interactive use with M-x.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1710 (filename, newname, ok_if_already_exists)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1711 Lisp_Object filename, newname, ok_if_already_exists;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1712 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1713 #ifdef NO_ARG_ARRAY
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1714 Lisp_Object args[2];
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1715 #endif
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1716 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1717 struct gcpro gcpro1, gcpro2;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1718
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1719 GCPRO2 (filename, newname);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1720 CHECK_STRING (filename, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1721 CHECK_STRING (newname, 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1722 filename = Fexpand_file_name (filename, Qnil);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1723 newname = Fexpand_file_name (newname, Qnil);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1724
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1725 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1726 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
1727 handler = Ffind_file_name_handler (filename);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1728 if (!NILP (handler))
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1729 return call3 (handler, Qrename_file, filename, newname);
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1730
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
1731 if (NILP (ok_if_already_exists)
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1732 || XTYPE (ok_if_already_exists) == Lisp_Int)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1733 barf_or_query_if_file_exists (newname, "rename to it",
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1734 XTYPE (ok_if_already_exists) == Lisp_Int);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1735 #ifndef BSD4_1
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1736 if (0 > rename (XSTRING (filename)->data, XSTRING (newname)->data))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1737 #else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1738 if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1739 || 0 > unlink (XSTRING (filename)->data))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1740 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1741 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1742 if (errno == EXDEV)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1743 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1744 Fcopy_file (filename, newname, ok_if_already_exists, Qt);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1745 Fdelete_file (filename);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1746 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1747 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1748 #ifdef NO_ARG_ARRAY
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1749 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1750 args[0] = filename;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1751 args[1] = newname;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1752 report_file_error ("Renaming", Flist (2, args));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1753 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1754 #else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1755 report_file_error ("Renaming", Flist (2, &filename));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1756 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1757 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1758 UNGCPRO;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1759 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1760 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1761
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1762 DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1763 "fAdd name to file: \nFName to add to %s: \np",
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1764 "Give FILE additional name NEWNAME. Both args strings.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1765 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1766 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1767 A number as third arg means request confirmation if NEWNAME already exists.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1768 This is what happens in interactive use with M-x.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1769 (filename, newname, ok_if_already_exists)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1770 Lisp_Object filename, newname, ok_if_already_exists;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1771 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1772 #ifdef NO_ARG_ARRAY
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1773 Lisp_Object args[2];
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1774 #endif
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1775 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1776 struct gcpro gcpro1, gcpro2;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1777
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1778 GCPRO2 (filename, newname);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1779 CHECK_STRING (filename, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1780 CHECK_STRING (newname, 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1781 filename = Fexpand_file_name (filename, Qnil);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1782 newname = Fexpand_file_name (newname, Qnil);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1783
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1784 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1785 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
1786 handler = Ffind_file_name_handler (filename);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1787 if (!NILP (handler))
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1788 return call3 (handler, Qadd_name_to_file, filename, newname);
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1789
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
1790 if (NILP (ok_if_already_exists)
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1791 || XTYPE (ok_if_already_exists) == Lisp_Int)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1792 barf_or_query_if_file_exists (newname, "make it a new name",
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1793 XTYPE (ok_if_already_exists) == Lisp_Int);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1794 unlink (XSTRING (newname)->data);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1795 if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1796 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1797 #ifdef NO_ARG_ARRAY
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1798 args[0] = filename;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1799 args[1] = newname;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1800 report_file_error ("Adding new name", Flist (2, args));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1801 #else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1802 report_file_error ("Adding new name", Flist (2, &filename));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1803 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1804 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1805
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1806 UNGCPRO;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1807 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1808 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1809
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1810 #ifdef S_IFLNK
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1811 DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1812 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1813 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1814 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1815 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1816 A number as third arg means request confirmation if NEWNAME already exists.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1817 This happens for interactive use with M-x.")
732
a8d94735277e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 689
diff changeset
1818 (filename, linkname, ok_if_already_exists)
a8d94735277e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 689
diff changeset
1819 Lisp_Object filename, linkname, ok_if_already_exists;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1820 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1821 #ifdef NO_ARG_ARRAY
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1822 Lisp_Object args[2];
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1823 #endif
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1824 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1825 struct gcpro gcpro1, gcpro2;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1826
732
a8d94735277e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 689
diff changeset
1827 GCPRO2 (filename, linkname);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1828 CHECK_STRING (filename, 0);
732
a8d94735277e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 689
diff changeset
1829 CHECK_STRING (linkname, 1);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1830 #if 0 /* This made it impossible to make a link to a relative name. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1831 filename = Fexpand_file_name (filename, Qnil);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1832 #endif
732
a8d94735277e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 689
diff changeset
1833 linkname = Fexpand_file_name (linkname, Qnil);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1834
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1835 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1836 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
1837 handler = Ffind_file_name_handler (filename);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1838 if (!NILP (handler))
848
58d3ed08f776 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 843
diff changeset
1839 return call3 (handler, Qmake_symbolic_link, filename, linkname);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1840
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
1841 if (NILP (ok_if_already_exists)
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1842 || XTYPE (ok_if_already_exists) == Lisp_Int)
732
a8d94735277e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 689
diff changeset
1843 barf_or_query_if_file_exists (linkname, "make it a link",
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1844 XTYPE (ok_if_already_exists) == Lisp_Int);
732
a8d94735277e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 689
diff changeset
1845 if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1846 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1847 /* If we didn't complain already, silently delete existing file. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1848 if (errno == EEXIST)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1849 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1850 unlink (XSTRING (filename)->data);
732
a8d94735277e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 689
diff changeset
1851 if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1852 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1853 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1854
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1855 #ifdef NO_ARG_ARRAY
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1856 args[0] = filename;
732
a8d94735277e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 689
diff changeset
1857 args[1] = linkname;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1858 report_file_error ("Making symbolic link", Flist (2, args));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1859 #else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1860 report_file_error ("Making symbolic link", Flist (2, &filename));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1861 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1862 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1863 UNGCPRO;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1864 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1865 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1866 #endif /* S_IFLNK */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1867
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1868 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1869
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1870 DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1871 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1872 "Define the job-wide logical name NAME to have the value STRING.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1873 If STRING is nil or a null string, the logical name NAME is deleted.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1874 (varname, string)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1875 Lisp_Object varname;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1876 Lisp_Object string;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1877 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1878 CHECK_STRING (varname, 0);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
1879 if (NILP (string))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1880 delete_logical_name (XSTRING (varname)->data);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1881 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1882 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1883 CHECK_STRING (string, 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1884
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1885 if (XSTRING (string)->size == 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1886 delete_logical_name (XSTRING (varname)->data);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1887 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1888 define_logical_name (XSTRING (varname)->data, XSTRING (string)->data);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1889 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1890
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1891 return string;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1892 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1893 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1894
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1895 #ifdef HPUX_NET
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1896
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1897 DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1898 "Open a network connection to PATH using LOGIN as the login string.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1899 (path, login)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1900 Lisp_Object path, login;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1901 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1902 int netresult;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1903
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1904 CHECK_STRING (path, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1905 CHECK_STRING (login, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1906
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1907 netresult = netunam (XSTRING (path)->data, XSTRING (login)->data);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1908
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1909 if (netresult == -1)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1910 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1911 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1912 return Qt;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1913 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1914 #endif /* HPUX_NET */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1915
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1916 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1917 1, 1, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1918 "Return t if file FILENAME specifies an absolute path name.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1919 On Unix, this is a name starting with a `/' or a `~'.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1920 (filename)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1921 Lisp_Object filename;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1922 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1923 unsigned char *ptr;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1924
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1925 CHECK_STRING (filename, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1926 ptr = XSTRING (filename)->data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1927 if (*ptr == '/' || *ptr == '~'
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1928 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1929 /* ??? This criterion is probably wrong for '<'. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1930 || index (ptr, ':') || index (ptr, '<')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1931 || (*ptr == '[' && (ptr[1] != '-' || (ptr[2] != '.' && ptr[2] != ']'))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1932 && ptr[1] != '.')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1933 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1934 )
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1935 return Qt;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1936 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1937 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1938 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1939
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1940 DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1941 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1942 See also `file-readable-p' and `file-attributes'.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1943 (filename)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1944 Lisp_Object filename;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1945 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1946 Lisp_Object abspath;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1947 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1948
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1949 CHECK_STRING (filename, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1950 abspath = Fexpand_file_name (filename, Qnil);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1951
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1952 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1953 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
1954 handler = Ffind_file_name_handler (abspath);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1955 if (!NILP (handler))
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
1956 return call2 (handler, Qfile_exists_p, abspath);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1957
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1958 return (access (XSTRING (abspath)->data, 0) >= 0) ? Qt : Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1959 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1960
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1961 DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1962 "Return t if FILENAME can be executed by you.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1963 For directories this means you can change to that directory.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1964 (filename)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1965 Lisp_Object filename;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1966
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1967 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1968 Lisp_Object abspath;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1969 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1970
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1971 CHECK_STRING (filename, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1972 abspath = Fexpand_file_name (filename, Qnil);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1973
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1974 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1975 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
1976 handler = Ffind_file_name_handler (abspath);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1977 if (!NILP (handler))
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
1978 return call2 (handler, Qfile_executable_p, abspath);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1979
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1980 return (access (XSTRING (abspath)->data, 1) >= 0) ? Qt : Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1981 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1982
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1983 DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1984 "Return t if file FILENAME exists and you can read it.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1985 See also `file-exists-p' and `file-attributes'.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1986 (filename)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1987 Lisp_Object filename;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1988 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1989 Lisp_Object abspath;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1990 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1991
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1992 CHECK_STRING (filename, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1993 abspath = Fexpand_file_name (filename, Qnil);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1994
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1995 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1996 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
1997 handler = Ffind_file_name_handler (abspath);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
1998 if (!NILP (handler))
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
1999 return call2 (handler, Qfile_readable_p, abspath);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2000
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2001 return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2002 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2003
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2004 DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2005 "If file FILENAME is the name of a symbolic link\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2006 returns the name of the file to which it is linked.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2007 Otherwise returns NIL.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2008 (filename)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2009 Lisp_Object filename;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2010 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2011 #ifdef S_IFLNK
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2012 char *buf;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2013 int bufsize;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2014 int valsize;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2015 Lisp_Object val;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2016 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2017
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2018 CHECK_STRING (filename, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2019 filename = Fexpand_file_name (filename, Qnil);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2020
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2021 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2022 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
2023 handler = Ffind_file_name_handler (filename);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2024 if (!NILP (handler))
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2025 return call2 (handler, Qfile_symlink_p, filename);
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2026
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2027 bufsize = 100;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2028 while (1)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2029 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2030 buf = (char *) xmalloc (bufsize);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2031 bzero (buf, bufsize);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2032 valsize = readlink (XSTRING (filename)->data, buf, bufsize);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2033 if (valsize < bufsize) break;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2034 /* Buffer was not long enough */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2035 free (buf);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2036 bufsize *= 2;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2037 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2038 if (valsize == -1)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2039 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2040 free (buf);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2041 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2042 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2043 val = make_string (buf, valsize);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2044 free (buf);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2045 return val;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2046 #else /* not S_IFLNK */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2047 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2048 #endif /* not S_IFLNK */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2049 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2050
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2051 /* Having this before file-symlink-p mysteriously caused it to be forgotten
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2052 on the RT/PC. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2053 DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2054 "Return t if file FILENAME can be written or created by you.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2055 (filename)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2056 Lisp_Object filename;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2057 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2058 Lisp_Object abspath, dir;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2059 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2060
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2061 CHECK_STRING (filename, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2062 abspath = Fexpand_file_name (filename, Qnil);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2063
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2064 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2065 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
2066 handler = Ffind_file_name_handler (abspath);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2067 if (!NILP (handler))
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
2068 return call2 (handler, Qfile_writable_p, abspath);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2069
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2070 if (access (XSTRING (abspath)->data, 0) >= 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2071 return (access (XSTRING (abspath)->data, 2) >= 0) ? Qt : Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2072 dir = Ffile_name_directory (abspath);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2073 #ifdef VMS
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
2074 if (!NILP (dir))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2075 dir = Fdirectory_file_name (dir);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2076 #endif /* VMS */
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
2077 return (access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2078 ? Qt : Qnil);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2079 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2080
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2081 DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2082 "Return t if file FILENAME is the name of a directory as a file.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2083 A directory name spec may be given instead; then the value is t\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2084 if the directory so specified exists and really is a directory.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2085 (filename)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2086 Lisp_Object filename;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2087 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2088 register Lisp_Object abspath;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2089 struct stat st;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2090 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2091
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2092 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2093
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2094 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2095 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
2096 handler = Ffind_file_name_handler (abspath);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2097 if (!NILP (handler))
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
2098 return call2 (handler, Qfile_directory_p, abspath);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2099
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2100 if (stat (XSTRING (abspath)->data, &st) < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2101 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2102 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2103 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2104
536
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2105 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0,
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2106 "Return t if file FILENAME is the name of a directory as a file,\n\
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2107 and files in that directory can be opened by you. In order to use a\n\
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2108 directory as a buffer's current directory, this predicate must return true.\n\
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2109 A directory name spec may be given instead; then the value is t\n\
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2110 if the directory so specified exists and really is a readable and\n\
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2111 searchable directory.")
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2112 (filename)
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2113 Lisp_Object filename;
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2114 {
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2115 Lisp_Object handler;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2116
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2117 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2118 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
2119 handler = Ffind_file_name_handler (filename);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2120 if (!NILP (handler))
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2121 return call2 (handler, Qfile_accessible_directory_p, filename);
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2122
536
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2123 if (NILP (Ffile_directory_p (filename))
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2124 || NILP (Ffile_executable_p (filename)))
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2125 return Qnil;
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2126 else
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2127 return Qt;
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2128 }
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2129
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2130 DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2131 "Return mode bits of FILE, as an integer.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2132 (filename)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2133 Lisp_Object filename;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2134 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2135 Lisp_Object abspath;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2136 struct stat st;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2137 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2138
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2139 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2140
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2141 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2142 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
2143 handler = Ffind_file_name_handler (abspath);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2144 if (!NILP (handler))
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
2145 return call2 (handler, Qfile_modes, abspath);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2146
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2147 if (stat (XSTRING (abspath)->data, &st) < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2148 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2149 return make_number (st.st_mode & 07777);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2150 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2151
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2152 DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2153 "Set mode bits of FILE to MODE (an integer).\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2154 Only the 12 low bits of MODE are used.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2155 (filename, mode)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2156 Lisp_Object filename, mode;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2157 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2158 Lisp_Object abspath;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2159 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2160
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2161 abspath = Fexpand_file_name (filename, current_buffer->directory);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2162 CHECK_NUMBER (mode, 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2163
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2164 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2165 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
2166 handler = Ffind_file_name_handler (abspath);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2167 if (!NILP (handler))
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
2168 return call3 (handler, Qset_file_modes, abspath, mode);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2169
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2170 #ifndef APOLLO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2171 if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2172 report_file_error ("Doing chmod", Fcons (abspath, Qnil));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2173 #else /* APOLLO */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2174 if (!egetenv ("USE_DOMAIN_ACLS"))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2175 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2176 struct stat st;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2177 struct timeval tvp[2];
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2178
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2179 /* chmod on apollo also change the file's modtime; need to save the
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2180 modtime and then restore it. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2181 if (stat (XSTRING (abspath)->data, &st) < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2182 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2183 report_file_error ("Doing chmod", Fcons (abspath, Qnil));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2184 return (Qnil);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2185 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2186
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2187 if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2188 report_file_error ("Doing chmod", Fcons (abspath, Qnil));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2189
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2190 /* reset the old accessed and modified times. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2191 tvp[0].tv_sec = st.st_atime + 1; /* +1 due to an Apollo roundoff bug */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2192 tvp[0].tv_usec = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2193 tvp[1].tv_sec = st.st_mtime + 1; /* +1 due to an Apollo roundoff bug */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2194 tvp[1].tv_usec = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2195
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2196 if (utimes (XSTRING (abspath)->data, tvp) < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2197 report_file_error ("Doing utimes", Fcons (abspath, Qnil));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2198 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2199 #endif /* APOLLO */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2200
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2201 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2202 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2203
1763
65e858c07a8b (Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
parents: 1762
diff changeset
2204 DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
1762
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2205 "Set the file permission bits for newly created files.\n\
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2206 The argument MODE should be an integer; only the low 9 bits are used.\n\
550
3072b38789a7 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 536
diff changeset
2207 This setting is inherited by subprocesses.")
1762
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2208 (mode)
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2209 Lisp_Object mode;
550
3072b38789a7 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 536
diff changeset
2210 {
1762
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2211 CHECK_NUMBER (mode, 0);
550
3072b38789a7 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 536
diff changeset
2212
1762
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2213 umask ((~ XINT (mode)) & 0777);
550
3072b38789a7 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 536
diff changeset
2214
3072b38789a7 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 536
diff changeset
2215 return Qnil;
3072b38789a7 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 536
diff changeset
2216 }
3072b38789a7 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 536
diff changeset
2217
1763
65e858c07a8b (Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
parents: 1762
diff changeset
2218 DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
1762
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2219 "Return the default file protection for created files.\n\
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2220 The value is an integer.")
550
3072b38789a7 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 536
diff changeset
2221 ()
3072b38789a7 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 536
diff changeset
2222 {
1762
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2223 int realmask;
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2224 Lisp_Object value;
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2225
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2226 realmask = umask (0);
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2227 umask (realmask);
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2228
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2229 XSET (value, Lisp_Int, (~ realmask) & 0777);
d70878f22be4 (Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents: 1761
diff changeset
2230 return value;
550
3072b38789a7 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 536
diff changeset
2231 }
3072b38789a7 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 536
diff changeset
2232
689
45401d45581d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 686
diff changeset
2233 #ifdef unix
45401d45581d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 686
diff changeset
2234
45401d45581d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 686
diff changeset
2235 DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
45401d45581d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 686
diff changeset
2236 "Tell Unix to finish all pending disk updates.")
45401d45581d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 686
diff changeset
2237 ()
45401d45581d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 686
diff changeset
2238 {
45401d45581d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 686
diff changeset
2239 sync ();
45401d45581d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 686
diff changeset
2240 return Qnil;
45401d45581d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 686
diff changeset
2241 }
45401d45581d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 686
diff changeset
2242
45401d45581d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 686
diff changeset
2243 #endif /* unix */
45401d45581d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 686
diff changeset
2244
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2245 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2246 "Return t if file FILE1 is newer than file FILE2.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2247 If FILE1 does not exist, the answer is nil;\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2248 otherwise, if FILE2 does not exist, the answer is t.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2249 (file1, file2)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2250 Lisp_Object file1, file2;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2251 {
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2252 Lisp_Object abspath1, abspath2;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2253 struct stat st;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2254 int mtime1;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2255 Lisp_Object handler;
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
2256 struct gcpro gcpro1, gcpro2;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2257
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2258 CHECK_STRING (file1, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2259 CHECK_STRING (file2, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2260
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
2261 abspath1 = Qnil;
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
2262 GCPRO2 (abspath1, file2);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2263 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2264 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
2265 UNGCPRO;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2266
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2267 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2268 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
2269 handler = Ffind_file_name_handler (abspath1);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2270 if (!NILP (handler))
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2271 return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2);
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2272
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2273 if (stat (XSTRING (abspath1)->data, &st) < 0)
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2274 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2275
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2276 mtime1 = st.st_mtime;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2277
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2278 if (stat (XSTRING (abspath2)->data, &st) < 0)
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2279 return Qt;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2280
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2281 return (mtime1 > st.st_mtime) ? Qt : Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2282 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2283
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2284 DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2285 1, 2, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2286 "Insert contents of file FILENAME after point.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2287 Returns list of absolute pathname and length of data inserted.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2288 If second argument VISIT is non-nil, the buffer's visited filename\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2289 and last save file modtime are set, and it is marked unmodified.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2290 If visiting and the file does not exist, visiting is completed\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2291 before the error is signaled.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2292 (filename, visit)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2293 Lisp_Object filename, visit;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2294 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2295 struct stat st;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2296 register int fd;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2297 register int inserted = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2298 register int how_much;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2299 int count = specpdl_ptr - specpdl;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2300 struct gcpro gcpro1;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2301 Lisp_Object handler, val;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2302
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2303 val = Qnil;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2304
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2305 GCPRO1 (filename);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
2306 if (!NILP (current_buffer->read_only))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2307 Fbarf_if_buffer_read_only();
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2308
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2309 CHECK_STRING (filename, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2310 filename = Fexpand_file_name (filename, Qnil);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2311
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2312 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2313 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
2314 handler = Ffind_file_name_handler (filename);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2315 if (!NILP (handler))
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2316 {
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2317 val = call3 (handler, Qinsert_file_contents, filename, visit);
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2318 st.st_mtime = 0;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2319 goto handled;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2320 }
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2321
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2322 fd = -1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2323
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2324 #ifndef APOLLO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2325 if (stat (XSTRING (filename)->data, &st) < 0
410
7812e9efc1af *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 372
diff changeset
2326 || (fd = open (XSTRING (filename)->data, 0)) < 0)
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2327 #else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2328 if ((fd = open (XSTRING (filename)->data, 0)) < 0
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2329 || fstat (fd, &st) < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2330 #endif /* not APOLLO */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2331 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2332 if (fd >= 0) close (fd);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
2333 if (NILP (visit))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2334 report_file_error ("Opening input file", Fcons (filename, Qnil));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2335 st.st_mtime = -1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2336 how_much = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2337 goto notfound;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2338 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2339
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2340 record_unwind_protect (close_file_unwind, make_number (fd));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2341
752
f7c08f6bd753 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
2342 #ifdef S_IFSOCK
f7c08f6bd753 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
2343 /* This code will need to be changed in order to work on named
f7c08f6bd753 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
2344 pipes, and it's probably just not worth it. So we should at
f7c08f6bd753 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
2345 least signal an error. */
f7c08f6bd753 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
2346 if ((st.st_mode & S_IFMT) == S_IFSOCK)
f7c08f6bd753 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
2347 Fsignal (Qfile_error,
f7c08f6bd753 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
2348 Fcons (build_string ("reading from named pipe"),
f7c08f6bd753 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
2349 Fcons (filename, Qnil)));
f7c08f6bd753 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
2350 #endif
f7c08f6bd753 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
2351
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2352 /* Supposedly happens on VMS. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2353 if (st.st_size < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2354 error ("File size is negative");
752
f7c08f6bd753 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
2355
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2356 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2357 register Lisp_Object temp;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2358
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2359 /* Make sure point-max won't overflow after this insertion. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2360 XSET (temp, Lisp_Int, st.st_size + Z);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2361 if (st.st_size + Z != XINT (temp))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2362 error ("maximum buffer size exceeded");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2363 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2364
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
2365 if (NILP (visit))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2366 prepare_to_modify_buffer (point, point);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2367
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2368 move_gap (point);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2369 if (GAP_SIZE < st.st_size)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2370 make_gap (st.st_size - GAP_SIZE);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2371
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2372 while (1)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2373 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2374 int try = min (st.st_size - inserted, 64 << 10);
592
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
2375 int this;
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
2376
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
2377 /* Allow quitting out of the actual I/O. */
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
2378 immediate_quit = 1;
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
2379 QUIT;
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
2380 this = read (fd, &FETCH_CHAR (point + inserted - 1) + 1, try);
e65af468dcc2 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 564
diff changeset
2381 immediate_quit = 0;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2382
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2383 if (this <= 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2384 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2385 how_much = this;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2386 break;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2387 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2388
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2389 GPT += this;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2390 GAP_SIZE -= this;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2391 ZV += this;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2392 Z += this;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2393 inserted += this;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2394 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2395
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2396 if (inserted > 0)
1240
7365d006d0a0 (Finsert_file_contents): Do record_insert, then inc MODIFF.
Richard M. Stallman <rms@gnu.org>
parents: 1204
diff changeset
2397 {
7365d006d0a0 (Finsert_file_contents): Do record_insert, then inc MODIFF.
Richard M. Stallman <rms@gnu.org>
parents: 1204
diff changeset
2398 record_insert (point, inserted);
1299
b8337cdf2e8b * fileio.c (Finsert_file_contents): Call offset_intervals() if
Joseph Arceneaux <jla@gnu.org>
parents: 1240
diff changeset
2399
b8337cdf2e8b * fileio.c (Finsert_file_contents): Call offset_intervals() if
Joseph Arceneaux <jla@gnu.org>
parents: 1240
diff changeset
2400 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
b8337cdf2e8b * fileio.c (Finsert_file_contents): Call offset_intervals() if
Joseph Arceneaux <jla@gnu.org>
parents: 1240
diff changeset
2401 offset_intervals (current_buffer, point, inserted);
1240
7365d006d0a0 (Finsert_file_contents): Do record_insert, then inc MODIFF.
Richard M. Stallman <rms@gnu.org>
parents: 1204
diff changeset
2402 MODIFF++;
7365d006d0a0 (Finsert_file_contents): Do record_insert, then inc MODIFF.
Richard M. Stallman <rms@gnu.org>
parents: 1204
diff changeset
2403 }
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2404
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2405 close (fd);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2406
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2407 /* Discard the unwind protect */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2408 specpdl_ptr = specpdl + count;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2409
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2410 if (how_much < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2411 error ("IO error reading %s: %s",
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2412 XSTRING (filename)->data, err_str (errno));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2413
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2414 notfound:
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2415 handled:
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2416
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
2417 if (!NILP (visit))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2418 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2419 current_buffer->undo_list = Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2420 #ifdef APOLLO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2421 stat (XSTRING (filename)->data, &st);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2422 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2423 current_buffer->modtime = st.st_mtime;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2424 current_buffer->save_modified = MODIFF;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2425 current_buffer->auto_save_modified = MODIFF;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2426 XFASTINT (current_buffer->save_length) = Z - BEG;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2427 #ifdef CLASH_DETECTION
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2428 if (NILP (handler))
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2429 {
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2430 if (!NILP (current_buffer->filename))
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2431 unlock_file (current_buffer->filename);
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2432 unlock_file (filename);
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2433 }
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2434 #endif /* CLASH_DETECTION */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2435 current_buffer->filename = filename;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2436 /* If visiting nonexistent file, return nil. */
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2437 if (current_buffer->modtime == -1)
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2438 report_file_error ("Opening input file", Fcons (filename, Qnil));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2439 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2440
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2441 signal_after_change (point, 0, inserted);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2442
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2443 if (!NILP (val))
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2444 RETURN_UNGCPRO (val);
350
80a890dbbeb5 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 230
diff changeset
2445 RETURN_UNGCPRO (Fcons (filename,
80a890dbbeb5 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 230
diff changeset
2446 Fcons (make_number (inserted),
80a890dbbeb5 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 230
diff changeset
2447 Qnil)));
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2448 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2449
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2450 DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 5,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2451 "r\nFWrite region to file: ",
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2452 "Write current region into specified file.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2453 When called from a program, takes three arguments:\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2454 START, END and FILENAME. START and END are buffer positions.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2455 Optional fourth argument APPEND if non-nil means\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2456 append to existing file contents (if any).\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2457 Optional fifth argument VISIT if t means\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2458 set the last-save-file-modtime of buffer to this file's modtime\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2459 and mark buffer not modified.\n\
1377
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2460 If VISIT is a string, it is a second file name;\n\
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2461 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2462 VISIT is also the file name to lock and unlock for clash detection.\n\
1761
b9ef55b0df4a (Fwrite_region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1679
diff changeset
2463 If VISIT is neither t nor nil nor a string,\n\
b9ef55b0df4a (Fwrite_region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1679
diff changeset
2464 that means do not print the \"Wrote file\" message.\n\
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2465 Kludgy feature: if START is a string, then that string is written\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2466 to the file, instead of any buffer contents, and END is ignored.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2467 (start, end, filename, append, visit)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2468 Lisp_Object start, end, filename, append, visit;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2469 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2470 register int desc;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2471 int failure;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2472 int save_errno;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2473 unsigned char *fn;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2474 struct stat st;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2475 int tem;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2476 int count = specpdl_ptr - specpdl;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2477 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2478 unsigned char *fname = 0; /* If non-0, original filename (must rename) */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2479 #endif /* VMS */
848
58d3ed08f776 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 843
diff changeset
2480 Lisp_Object handler;
1377
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2481 Lisp_Object visit_file = XTYPE (visit) == Lisp_String ? visit : filename;
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2482 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2483
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2484 /* Special kludge to simplify auto-saving */
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
2485 if (NILP (start))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2486 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2487 XFASTINT (start) = BEG;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2488 XFASTINT (end) = Z;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2489 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2490 else if (XTYPE (start) != Lisp_String)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2491 validate_region (&start, &end);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2492
1377
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2493 GCPRO4 (start, filename, visit, visit_file);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2494 filename = Fexpand_file_name (filename, Qnil);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2495
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2496 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2497 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
2498 handler = Ffind_file_name_handler (filename);
848
58d3ed08f776 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 843
diff changeset
2499
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2500 if (!NILP (handler))
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2501 {
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2502 Lisp_Object args[7];
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2503 Lisp_Object val;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2504 args[0] = handler;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2505 args[1] = Qwrite_region;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2506 args[2] = start;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2507 args[3] = end;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2508 args[4] = filename;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2509 args[5] = append;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2510 args[6] = visit;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2511 val = Ffuncall (7, args);
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2512
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2513 /* Do this before reporting IO error
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2514 to avoid a "file has changed on disk" warning on
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2515 next attempt to save. */
1377
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2516 if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2517 {
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2518 current_buffer->modtime = 0;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2519 current_buffer->save_modified = MODIFF;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2520 XFASTINT (current_buffer->save_length) = Z - BEG;
1377
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2521 current_buffer->filename = visit_file;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2522 }
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
2523 UNGCPRO;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2524 return val;
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2525 }
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2526
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2527 #ifdef CLASH_DETECTION
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2528 if (!auto_saving)
1377
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2529 lock_file (visit_file);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2530 #endif /* CLASH_DETECTION */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2531
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
2532 fn = XSTRING (filename)->data;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2533 desc = -1;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
2534 if (!NILP (append))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2535 desc = open (fn, O_WRONLY);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2536
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2537 if (desc < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2538 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2539 if (auto_saving) /* Overwrite any previous version of autosave file */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2540 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2541 vms_truncate (fn); /* if fn exists, truncate to zero length */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2542 desc = open (fn, O_RDWR);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2543 if (desc < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2544 desc = creat_copy_attrs (XTYPE (current_buffer->filename) == Lisp_String
536
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2545 ? XSTRING (current_buffer->filename)->data : 0,
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2546 fn);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2547 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2548 else /* Write to temporary name and rename if no errors */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2549 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2550 Lisp_Object temp_name;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2551 temp_name = Ffile_name_directory (filename);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2552
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
2553 if (!NILP (temp_name))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2554 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2555 temp_name = Fmake_temp_name (concat2 (temp_name,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2556 build_string ("$$SAVE$$")));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2557 fname = XSTRING (filename)->data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2558 fn = XSTRING (temp_name)->data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2559 desc = creat_copy_attrs (fname, fn);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2560 if (desc < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2561 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2562 /* If we can't open the temporary file, try creating a new
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2563 version of the original file. VMS "creat" creates a
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2564 new version rather than truncating an existing file. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2565 fn = fname;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2566 fname = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2567 desc = creat (fn, 0666);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2568 #if 0 /* This can clobber an existing file and fail to replace it,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2569 if the user runs out of space. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2570 if (desc < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2571 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2572 /* We can't make a new version;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2573 try to truncate and rewrite existing version if any. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2574 vms_truncate (fn);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2575 desc = open (fn, O_RDWR);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2576 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2577 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2578 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2579 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2580 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2581 desc = creat (fn, 0666);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2582 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2583 #else /* not VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2584 desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2585 #endif /* not VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2586
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
2587 UNGCPRO;
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
2588
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2589 if (desc < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2590 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2591 #ifdef CLASH_DETECTION
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2592 save_errno = errno;
1377
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2593 if (!auto_saving) unlock_file (visit_file);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2594 errno = save_errno;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2595 #endif /* CLASH_DETECTION */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2596 report_file_error ("Opening output file", Fcons (filename, Qnil));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2597 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2598
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2599 record_unwind_protect (close_file_unwind, make_number (desc));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2600
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
2601 if (!NILP (append))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2602 if (lseek (desc, 0, 2) < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2603 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2604 #ifdef CLASH_DETECTION
1377
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2605 if (!auto_saving) unlock_file (visit_file);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2606 #endif /* CLASH_DETECTION */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2607 report_file_error ("Lseek error", Fcons (filename, Qnil));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2608 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2609
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2610 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2611 /*
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2612 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2613 * if we do writes that don't end with a carriage return. Furthermore
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2614 * it cannot handle writes of more then 16K. The modified
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2615 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2616 * this EXCEPT for the last record (iff it doesn't end with a carriage
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2617 * return). This implies that if your buffer doesn't end with a carriage
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2618 * return, you get one free... tough. However it also means that if
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2619 * we make two calls to sys_write (a la the following code) you can
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2620 * get one at the gap as well. The easiest way to fix this (honest)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2621 * is to move the gap to the next newline (or the end of the buffer).
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2622 * Thus this change.
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2623 *
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2624 * Yech!
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2625 */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2626 if (GPT > BEG && GPT_ADDR[-1] != '\n')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2627 move_gap (find_next_newline (GPT, 1));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2628 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2629
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2630 failure = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2631 immediate_quit = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2632
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2633 if (XTYPE (start) == Lisp_String)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2634 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2635 failure = 0 > e_write (desc, XSTRING (start)->data,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2636 XSTRING (start)->size);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2637 save_errno = errno;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2638 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2639 else if (XINT (start) != XINT (end))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2640 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2641 if (XINT (start) < GPT)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2642 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2643 register int end1 = XINT (end);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2644 tem = XINT (start);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2645 failure = 0 > e_write (desc, &FETCH_CHAR (tem),
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2646 min (GPT, end1) - tem);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2647 save_errno = errno;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2648 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2649
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2650 if (XINT (end) > GPT && !failure)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2651 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2652 tem = XINT (start);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2653 tem = max (tem, GPT);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2654 failure = 0 > e_write (desc, &FETCH_CHAR (tem), XINT (end) - tem);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2655 save_errno = errno;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2656 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2657 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2658
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2659 immediate_quit = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2660
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2661 #ifndef USG
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2662 #ifndef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2663 #ifndef BSD4_1
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2664 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2665 Disk full in NFS may be reported here. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2666 if (fsync (desc) < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2667 failure = 1, save_errno = errno;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2668 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2669 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2670 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2671
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2672 /* Spurious "file has changed on disk" warnings have been
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2673 observed on Suns as well.
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2674 It seems that `close' can change the modtime, under nfs.
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2675
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2676 (This has supposedly been fixed in Sunos 4,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2677 but who knows about all the other machines with NFS?) */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2678 #if 0
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2679
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2680 /* On VMS and APOLLO, must do the stat after the close
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2681 since closing changes the modtime. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2682 #ifndef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2683 #ifndef APOLLO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2684 /* Recall that #if defined does not work on VMS. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2685 #define FOO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2686 fstat (desc, &st);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2687 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2688 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2689 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2690
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2691 /* NFS can report a write failure now. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2692 if (close (desc) < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2693 failure = 1, save_errno = errno;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2694
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2695 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2696 /* If we wrote to a temporary name and had no errors, rename to real name. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2697 if (fname)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2698 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2699 if (!failure)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2700 failure = (rename (fn, fname) != 0), save_errno = errno;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2701 fn = fname;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2702 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2703 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2704
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2705 #ifndef FOO
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2706 stat (fn, &st);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2707 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2708 /* Discard the unwind protect */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2709 specpdl_ptr = specpdl + count;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2710
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2711 #ifdef CLASH_DETECTION
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2712 if (!auto_saving)
1377
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2713 unlock_file (visit_file);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2714 #endif /* CLASH_DETECTION */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2715
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2716 /* Do this before reporting IO error
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2717 to avoid a "file has changed on disk" warning on
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2718 next attempt to save. */
1377
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2719 if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2720 current_buffer->modtime = st.st_mtime;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2721
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2722 if (failure)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2723 error ("IO error writing %s: %s", fn, err_str (save_errno));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2724
1377
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2725 if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2726 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2727 current_buffer->save_modified = MODIFF;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2728 XFASTINT (current_buffer->save_length) = Z - BEG;
1377
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2729 current_buffer->filename = visit_file;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2730 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
2731 else if (!NILP (visit))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2732 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2733
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2734 if (!auto_saving)
1377
dcec08a3bec4 (Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents: 1358
diff changeset
2735 message ("Wrote %s", XSTRING (visit_file)->data);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2736
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2737 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2738 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2739
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2740 int
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2741 e_write (desc, addr, len)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2742 int desc;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2743 register char *addr;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2744 register int len;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2745 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2746 char buf[16 * 1024];
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2747 register char *p, *end;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2748
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2749 if (!EQ (current_buffer->selective_display, Qt))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2750 return write (desc, addr, len) - len;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2751 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2752 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2753 p = buf;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2754 end = p + sizeof buf;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2755 while (len--)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2756 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2757 if (p == end)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2758 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2759 if (write (desc, buf, sizeof buf) != sizeof buf)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2760 return -1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2761 p = buf;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2762 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2763 *p = *addr++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2764 if (*p++ == '\015')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2765 p[-1] = '\n';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2766 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2767 if (p != buf)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2768 if (write (desc, buf, p - buf) != p - buf)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2769 return -1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2770 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2771 return 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2772 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2773
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2774 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2775 Sverify_visited_file_modtime, 1, 1, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2776 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2777 This means that the file has not been changed since it was visited or saved.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2778 (buf)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2779 Lisp_Object buf;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2780 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2781 struct buffer *b;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2782 struct stat st;
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2783 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2784
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2785 CHECK_BUFFER (buf, 0);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2786 b = XBUFFER (buf);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2787
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2788 if (XTYPE (b->filename) != Lisp_String) return Qt;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2789 if (b->modtime == 0) return Qt;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2790
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2791 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2792 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
2793 handler = Ffind_file_name_handler (b->filename);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2794 if (!NILP (handler))
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
2795 return call2 (handler, Qverify_visited_file_modtime, buf);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2796
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2797 if (stat (XSTRING (b->filename)->data, &st) < 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2798 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2799 /* If the file doesn't exist now and didn't exist before,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2800 we say that it isn't modified, provided the error is a tame one. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2801 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2802 st.st_mtime = -1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2803 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2804 st.st_mtime = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2805 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2806 if (st.st_mtime == b->modtime
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2807 /* If both are positive, accept them if they are off by one second. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2808 || (st.st_mtime > 0 && b->modtime > 0
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2809 && (st.st_mtime == b->modtime + 1
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2810 || st.st_mtime == b->modtime - 1)))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2811 return Qt;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2812 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2813 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2814
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2815 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2816 Sclear_visited_file_modtime, 0, 0, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2817 "Clear out records of last mod time of visited file.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2818 Next attempt to save will certainly not complain of a discrepancy.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2819 ()
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2820 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2821 current_buffer->modtime = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2822 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2823 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2824
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2825 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2826 Sset_visited_file_modtime, 0, 0, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2827 "Update buffer's recorded modification time from the visited file's time.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2828 Useful if the buffer was not read from the file normally\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2829 or if the file itself has been changed for some known benign reason.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2830 ()
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2831 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2832 register Lisp_Object filename;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2833 struct stat st;
848
58d3ed08f776 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 843
diff changeset
2834 Lisp_Object handler;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2835
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2836 filename = Fexpand_file_name (current_buffer->filename, Qnil);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2837
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2838 /* If the file name has special constructs in it,
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2839 call the corresponding file handler. */
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
2840 handler = Ffind_file_name_handler (filename);
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2841 if (!NILP (handler))
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2842 current_buffer->modtime = 0;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2843
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
2844 else if (stat (XSTRING (filename)->data, &st) >= 0)
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2845 current_buffer->modtime = st.st_mtime;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2846
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2847 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2848 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2849
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2850 Lisp_Object
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2851 auto_save_error ()
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2852 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2853 unsigned char *name = XSTRING (current_buffer->name)->data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2854
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2855 ring_bell ();
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2856 message ("Autosaving...error for %s", name);
806
d42e1151eed8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 752
diff changeset
2857 Fsleep_for (make_number (1), Qnil);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2858 message ("Autosaving...error!for %s", name);
806
d42e1151eed8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 752
diff changeset
2859 Fsleep_for (make_number (1), Qnil);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2860 message ("Autosaving...error for %s", name);
806
d42e1151eed8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 752
diff changeset
2861 Fsleep_for (make_number (1), Qnil);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2862 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2863 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2864
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2865 Lisp_Object
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2866 auto_save_1 ()
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2867 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2868 unsigned char *fn;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2869 struct stat st;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2870
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2871 /* Get visited file's mode to become the auto save file's mode. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2872 if (stat (XSTRING (current_buffer->filename)->data, &st) >= 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2873 /* But make sure we can overwrite it later! */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2874 auto_save_mode_bits = st.st_mode | 0600;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2875 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2876 auto_save_mode_bits = 0666;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2877
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2878 return
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2879 Fwrite_region (Qnil, Qnil,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2880 current_buffer->auto_save_file_name,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2881 Qnil, Qlambda);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2882 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2883
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2884 DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2885 "Auto-save all buffers that need it.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2886 This is all buffers that have auto-saving enabled\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2887 and are changed since last auto-saved.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2888 Auto-saving writes the buffer into a file\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2889 so that your editing is not lost if the system crashes.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2890 This file is not the file you visited; that changes only when you save.\n\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2891 Non-nil first argument means do not print any message if successful.\n\
621
eca8812e61cd *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 595
diff changeset
2892 Non-nil second argument means save only current buffer.")
1775
f9ac4c0d8b72 * fileio.c (Fdo_auto_save): Add CURRENT_ONLY argument, as
Jim Blandy <jimb@redhat.com>
parents: 1763
diff changeset
2893 (no_message, current_only)
f9ac4c0d8b72 * fileio.c (Fdo_auto_save): Add CURRENT_ONLY argument, as
Jim Blandy <jimb@redhat.com>
parents: 1763
diff changeset
2894 Lisp_Object no_message, current_only;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2895 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2896 struct buffer *old = current_buffer, *b;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2897 Lisp_Object tail, buf;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2898 int auto_saved = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2899 char *omessage = echo_area_glyphs;
1869
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2900 extern int minibuf_level;
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2901 int do_handled_files;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2902
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2903 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2904 point to non-strings reached from Vbuffer_alist. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2905
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2906 auto_saving = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2907 if (minibuf_level)
1775
f9ac4c0d8b72 * fileio.c (Fdo_auto_save): Add CURRENT_ONLY argument, as
Jim Blandy <jimb@redhat.com>
parents: 1763
diff changeset
2908 no_message = Qt;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2909
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2910 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2911 eventually call do-auto-save, so don't err here in that case. */
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
2912 if (!NILP (Vrun_hooks))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2913 call1 (Vrun_hooks, intern ("auto-save-hook"));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2914
1869
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2915 /* First, save all files which don't have handlers. If Emacs is
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2916 crashing, the handlers may tweak what is causing Emacs to crash
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2917 in the first place, and it would be a shame if Emacs failed to
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2918 autosave perfectly ordinary files because it couldn't handle some
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2919 ange-ftp'd file. */
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2920 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2921 for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2922 tail = XCONS (tail)->cdr)
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2923 {
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2924 buf = XCONS (XCONS (tail)->car)->cdr;
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2925 b = XBUFFER (buf);
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2926
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2927 if (!NILP (current_only)
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2928 && b != current_buffer)
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2929 continue;
1775
f9ac4c0d8b72 * fileio.c (Fdo_auto_save): Add CURRENT_ONLY argument, as
Jim Blandy <jimb@redhat.com>
parents: 1763
diff changeset
2930
1869
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2931 /* Check for auto save enabled
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2932 and file changed since last auto save
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2933 and file changed since last real save. */
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2934 if (XTYPE (b->auto_save_file_name) == Lisp_String
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2935 && b->save_modified < BUF_MODIFF (b)
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2936 && b->auto_save_modified < BUF_MODIFF (b)
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2937 && (do_handled_files
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2938 || NILP (Ffind_file_name_handler (b->auto_save_file_name))))
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2939 {
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2940 if ((XFASTINT (b->save_length) * 10
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2941 > (BUF_Z (b) - BUF_BEG (b)) * 13)
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2942 /* A short file is likely to change a large fraction;
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2943 spare the user annoying messages. */
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2944 && XFASTINT (b->save_length) > 5000
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2945 /* These messages are frequent and annoying for `*mail*'. */
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2946 && !EQ (b->filename, Qnil)
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2947 && NILP (no_message))
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2948 {
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2949 /* It has shrunk too much; turn off auto-saving here. */
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2950 message ("Buffer %s has shrunk a lot; auto save turned off there",
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2951 XSTRING (b->name)->data);
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2952 /* User can reenable saving with M-x auto-save. */
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2953 b->auto_save_file_name = Qnil;
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2954 /* Prevent warning from repeating if user does so. */
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2955 XFASTINT (b->save_length) = 0;
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2956 Fsleep_for (make_number (1), Qnil);
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2957 continue;
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2958 }
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2959 set_buffer_internal (b);
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2960 if (!auto_saved && NILP (no_message))
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2961 message1 ("Auto-saving...");
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2962 internal_condition_case (auto_save_1, Qt, auto_save_error);
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2963 auto_saved++;
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2964 b->auto_save_modified = BUF_MODIFF (b);
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2965 XFASTINT (current_buffer->save_length) = Z - BEG;
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2966 set_buffer_internal (old);
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2967 }
30eb06b22ae4 * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents: 1775
diff changeset
2968 }
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2969
1059
430923239064 (Fdo_auto_save): Always call record_auto_save.
Richard M. Stallman <rms@gnu.org>
parents: 1044
diff changeset
2970 /* Prevent another auto save till enough input events come in. */
430923239064 (Fdo_auto_save): Always call record_auto_save.
Richard M. Stallman <rms@gnu.org>
parents: 1044
diff changeset
2971 record_auto_save ();
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2972
1775
f9ac4c0d8b72 * fileio.c (Fdo_auto_save): Add CURRENT_ONLY argument, as
Jim Blandy <jimb@redhat.com>
parents: 1763
diff changeset
2973 if (auto_saved && NILP (no_message))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2974 message1 (omessage ? omessage : "Auto-saving...done");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2975
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2976 auto_saving = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2977 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2978 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2979
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2980 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2981 Sset_buffer_auto_saved, 0, 0, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2982 "Mark current buffer as auto-saved with its current text.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2983 No auto-save file will be written until the buffer changes again.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2984 ()
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2985 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2986 current_buffer->auto_save_modified = MODIFF;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2987 XFASTINT (current_buffer->save_length) = Z - BEG;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2988 return Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2989 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2990
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2991 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2992 0, 0, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2993 "Return t if buffer has been auto-saved since last read in or saved.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2994 ()
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2995 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2996 return (current_buffer->save_modified < current_buffer->auto_save_modified) ? Qt : Qnil;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2997 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2998
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2999 /* Reading and completing file names */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3000 extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions ();
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3001
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3002 DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3003 3, 3, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3004 "Internal subroutine for read-file-name. Do not call this.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3005 (string, dir, action)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3006 Lisp_Object string, dir, action;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3007 /* action is nil for complete, t for return list of completions,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3008 lambda for verify final value */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3009 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3010 Lisp_Object name, specdir, realdir, val, orig_string;
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3011 int changed;
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3012 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3013
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3014 realdir = dir;
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3015 name = string;
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3016 orig_string = Qnil;
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3017 specdir = Qnil;
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3018 changed = 0;
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3019 /* No need to protect ACTION--we only compare it with t and nil. */
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3020 GCPRO4 (string, realdir, name, specdir);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3021
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3022 if (XSTRING (string)->size == 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3023 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3024 if (EQ (action, Qlambda))
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3025 {
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3026 UNGCPRO;
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3027 return Qnil;
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3028 }
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3029 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3030 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3031 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3032 orig_string = string;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3033 string = Fsubstitute_in_file_name (string);
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3034 changed = NILP (Fstring_equal (string, orig_string));
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3035 name = Ffile_name_nondirectory (string);
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3036 val = Ffile_name_directory (string);
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3037 if (! NILP (val))
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3038 realdir = Fexpand_file_name (val, realdir);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3039 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3040
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
3041 if (NILP (action))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3042 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3043 specdir = Ffile_name_directory (string);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3044 val = Ffile_name_completion (name, realdir);
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3045 UNGCPRO;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3046 if (XTYPE (val) != Lisp_String)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3047 {
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3048 if (changed)
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3049 return string;
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3050 return val;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3051 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3052
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
3053 if (!NILP (specdir))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3054 val = concat2 (specdir, val);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3055 #ifndef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3056 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3057 register unsigned char *old, *new;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3058 register int n;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3059 int osize, count;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3060
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3061 osize = XSTRING (val)->size;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3062 /* Quote "$" as "$$" to get it past substitute-in-file-name */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3063 for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3064 if (*old++ == '$') count++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3065 if (count > 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3066 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3067 old = XSTRING (val)->data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3068 val = Fmake_string (make_number (osize + count), make_number (0));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3069 new = XSTRING (val)->data;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3070 for (n = osize; n > 0; n--)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3071 if (*old != '$')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3072 *new++ = *old++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3073 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3074 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3075 *new++ = '$';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3076 *new++ = '$';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3077 old++;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3078 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3079 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3080 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3081 #endif /* Not VMS */
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3082 return val;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3083 }
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3084 UNGCPRO;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3085
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3086 if (EQ (action, Qt))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3087 return Ffile_name_all_completions (name, realdir);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3088 /* Only other case actually used is ACTION = lambda */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3089 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3090 /* Supposedly this helps commands such as `cd' that read directory names,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3091 but can someone explain how it helps them? -- RMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3092 if (XSTRING (name)->size == 0)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3093 return Qt;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3094 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3095 return Ffile_exists_p (string);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3096 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3097
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3098 DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3099 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3100 Value is not expanded---you must call `expand-file-name' yourself.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3101 Default name to DEFAULT if user enters a null string.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3102 (If DEFAULT is omitted, the visited file name is used.)\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3103 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3104 Non-nil and non-t means also require confirmation after completion.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3105 Fifth arg INITIAL specifies text to start with.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3106 DIR defaults to current buffer's directory default.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3107 (prompt, dir, defalt, mustmatch, initial)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3108 Lisp_Object prompt, dir, defalt, mustmatch, initial;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3109 {
866
ae5c412a32ec entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 863
diff changeset
3110 Lisp_Object val, insdef, insdef1, tem;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3111 struct gcpro gcpro1, gcpro2;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3112 register char *homedir;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3113 int count;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3114
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
3115 if (NILP (dir))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3116 dir = current_buffer->directory;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
3117 if (NILP (defalt))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3118 defalt = current_buffer->filename;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3119
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3120 /* If dir starts with user's homedir, change that to ~. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3121 homedir = (char *) egetenv ("HOME");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3122 if (homedir != 0
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3123 && XTYPE (dir) == Lisp_String
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3124 && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3125 && XSTRING (dir)->data[strlen (homedir)] == '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3126 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3127 dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3128 XSTRING (dir)->size - strlen (homedir) + 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3129 XSTRING (dir)->data[0] = '~';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3130 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3131
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3132 if (insert_default_directory)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3133 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3134 insdef = dir;
866
ae5c412a32ec entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 863
diff changeset
3135 insdef1 = dir;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
3136 if (!NILP (initial))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3137 {
863
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3138 Lisp_Object args[2], pos;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3139
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3140 args[0] = insdef;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3141 args[1] = initial;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3142 insdef = Fconcat (2, args);
964
ea0c91e13641 * fileio.c (Fread_filename): When calling Fcompleting_read,
Jim Blandy <jimb@redhat.com>
parents: 945
diff changeset
3143 pos = make_number (XSTRING (dir)->size);
866
ae5c412a32ec entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 863
diff changeset
3144 insdef1 = Fcons (insdef, pos);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3145 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3146 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3147 else
866
ae5c412a32ec entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 863
diff changeset
3148 insdef = Qnil, insdef1 = Qnil;
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3149
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3150 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3151 count = specpdl_ptr - specpdl;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3152 specbind (intern ("completion-ignore-case"), Qt);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3153 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3154
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3155 GCPRO2 (insdef, defalt);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3156 val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
866
ae5c412a32ec entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 863
diff changeset
3157 dir, mustmatch, insdef1,
863
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3158 Qfile_name_history);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3159
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3160 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3161 unbind_to (count, Qnil);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3162 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3163
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3164 UNGCPRO;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
3165 if (NILP (val))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3166 error ("No file name specified");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3167 tem = Fstring_equal (val, insdef);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
3168 if (!NILP (tem) && !NILP (defalt))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3169 return defalt;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3170 return Fsubstitute_in_file_name (val);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3171 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3172
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3173 #if 0 /* Old version */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3174 DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3175 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3176 Value is not expanded---you must call `expand-file-name' yourself.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3177 Default name to DEFAULT if user enters a null string.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3178 (If DEFAULT is omitted, the visited file name is used.)\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3179 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3180 Non-nil and non-t means also require confirmation after completion.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3181 Fifth arg INITIAL specifies text to start with.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3182 DIR defaults to current buffer's directory default.")
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3183 (prompt, dir, defalt, mustmatch, initial)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3184 Lisp_Object prompt, dir, defalt, mustmatch, initial;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3185 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3186 Lisp_Object val, insdef, tem;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3187 struct gcpro gcpro1, gcpro2;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3188 register char *homedir;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3189 int count;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3190
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
3191 if (NILP (dir))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3192 dir = current_buffer->directory;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
3193 if (NILP (defalt))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3194 defalt = current_buffer->filename;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3195
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3196 /* If dir starts with user's homedir, change that to ~. */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3197 homedir = (char *) egetenv ("HOME");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3198 if (homedir != 0
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3199 && XTYPE (dir) == Lisp_String
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3200 && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3201 && XSTRING (dir)->data[strlen (homedir)] == '/')
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3202 {
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3203 dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3204 XSTRING (dir)->size - strlen (homedir) + 1);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3205 XSTRING (dir)->data[0] = '~';
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3206 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3207
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
3208 if (!NILP (initial))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3209 insdef = initial;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3210 else if (insert_default_directory)
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3211 insdef = dir;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3212 else
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3213 insdef = build_string ("");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3214
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3215 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3216 count = specpdl_ptr - specpdl;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3217 specbind (intern ("completion-ignore-case"), Qt);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3218 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3219
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3220 GCPRO2 (insdef, defalt);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3221 val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3222 dir, mustmatch,
863
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3223 insert_default_directory ? insdef : Qnil,
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3224 Qfile_name_history);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3225
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3226 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3227 unbind_to (count, Qnil);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3228 #endif
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3229
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3230 UNGCPRO;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
3231 if (NILP (val))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3232 error ("No file name specified");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3233 tem = Fstring_equal (val, insdef);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 410
diff changeset
3234 if (!NILP (tem) && !NILP (defalt))
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3235 return defalt;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3236 return Fsubstitute_in_file_name (val);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3237 }
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3238 #endif /* Old version */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3239
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3240 syms_of_fileio ()
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3241 {
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
3242 Qexpand_file_name = intern ("expand-file-name");
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
3243 Qdirectory_file_name = intern ("directory-file-name");
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
3244 Qfile_name_directory = intern ("file-name-directory");
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
3245 Qfile_name_nondirectory = intern ("file-name-nondirectory");
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
3246 Qunhandled_file_name_directory = intern ("unhandled-file-name-directory");
1105
80ad8d0704ba (Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents: 1071
diff changeset
3247 Qfile_name_as_directory = intern ("file-name-as-directory");
843
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3248 Qcopy_file = intern ("copy-file");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3249 Qmake_directory = intern ("make-directory");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3250 Qdelete_directory = intern ("delete-directory");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3251 Qdelete_file = intern ("delete-file");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3252 Qrename_file = intern ("rename-file");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3253 Qadd_name_to_file = intern ("add-name-to-file");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3254 Qmake_symbolic_link = intern ("make-symbolic-link");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3255 Qfile_exists_p = intern ("file-exists-p");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3256 Qfile_executable_p = intern ("file-executable-p");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3257 Qfile_readable_p = intern ("file-readable-p");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3258 Qfile_symlink_p = intern ("file-symlink-p");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3259 Qfile_writable_p = intern ("file-writable-p");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3260 Qfile_directory_p = intern ("file-directory-p");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3261 Qfile_accessible_directory_p = intern ("file-accessible-directory-p");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3262 Qfile_modes = intern ("file-modes");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3263 Qset_file_modes = intern ("set-file-modes");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3264 Qfile_newer_than_file_p = intern ("file-newer-than-file-p");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3265 Qinsert_file_contents = intern ("insert-file-contents");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3266 Qwrite_region = intern ("write-region");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3267 Qverify_visited_file_modtime = intern ("verify-visited-file-modtime");
8f6ea998ad0a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 806
diff changeset
3268
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
3269 staticpro (&Qexpand_file_name);
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
3270 staticpro (&Qdirectory_file_name);
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
3271 staticpro (&Qfile_name_directory);
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
3272 staticpro (&Qfile_name_nondirectory);
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
3273 staticpro (&Qunhandled_file_name_directory);
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
3274 staticpro (&Qfile_name_as_directory);
863
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3275 staticpro (&Qcopy_file);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3276 staticpro (&Qmake_directory);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3277 staticpro (&Qdelete_directory);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3278 staticpro (&Qdelete_file);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3279 staticpro (&Qrename_file);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3280 staticpro (&Qadd_name_to_file);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3281 staticpro (&Qmake_symbolic_link);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3282 staticpro (&Qfile_exists_p);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3283 staticpro (&Qfile_executable_p);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3284 staticpro (&Qfile_readable_p);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3285 staticpro (&Qfile_symlink_p);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3286 staticpro (&Qfile_writable_p);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3287 staticpro (&Qfile_directory_p);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3288 staticpro (&Qfile_accessible_directory_p);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3289 staticpro (&Qfile_modes);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3290 staticpro (&Qset_file_modes);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3291 staticpro (&Qfile_newer_than_file_p);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3292 staticpro (&Qinsert_file_contents);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3293 staticpro (&Qwrite_region);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3294 staticpro (&Qverify_visited_file_modtime);
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
3295
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
3296 Qfile_name_history = intern ("file-name-history");
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
3297 Fset (Qfile_name_history, Qnil);
863
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3298 staticpro (&Qfile_name_history);
427299469901 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
3299
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3300 Qfile_error = intern ("file-error");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3301 staticpro (&Qfile_error);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3302 Qfile_already_exists = intern("file-already-exists");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3303 staticpro (&Qfile_already_exists);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3304
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3305 Fput (Qfile_error, Qerror_conditions,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3306 Fcons (Qfile_error, Fcons (Qerror, Qnil)));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3307 Fput (Qfile_error, Qerror_message,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3308 build_string ("File error"));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3309
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3310 Fput (Qfile_already_exists, Qerror_conditions,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3311 Fcons (Qfile_already_exists,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3312 Fcons (Qfile_error, Fcons (Qerror, Qnil))));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3313 Fput (Qfile_already_exists, Qerror_message,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3314 build_string ("File already exists"));
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3315
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3316 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3317 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3318 insert_default_directory = 1;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3319
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3320 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm,
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3321 "*Non-nil means write new files with record format `stmlf'.\n\
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3322 nil means use format `var'. This variable is meaningful only on VMS.");
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3323 vms_stmlf_recfm = 0;
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3324
850
0bc61321ba50 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 848
diff changeset
3325 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
0bc61321ba50 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 848
diff changeset
3326 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
0bc61321ba50 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 848
diff changeset
3327 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
0bc61321ba50 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 848
diff changeset
3328 HANDLER.\n\
0bc61321ba50 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 848
diff changeset
3329 \n\
0bc61321ba50 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 848
diff changeset
3330 The first argument given to HANDLER is the name of the I/O primitive\n\
0bc61321ba50 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 848
diff changeset
3331 to be handled; the remaining arguments are the arguments that were\n\
0bc61321ba50 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 848
diff changeset
3332 passed to that primitive. For example, if you do\n\
0bc61321ba50 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 848
diff changeset
3333 (file-exists-p FILENAME)\n\
0bc61321ba50 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 848
diff changeset
3334 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
3335 (funcall HANDLER 'file-exists-p FILENAME)\n\
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
3336 The function `find-file-name-handler' checks this list for a handler\n\
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
3337 for its argument.");
1178
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3338 Vfile_name_handler_alist = Qnil;
fb4ec23ef80f Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents: 1105
diff changeset
3339
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
3340 defsubr (&Sfind_file_name_handler);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3341 defsubr (&Sfile_name_directory);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3342 defsubr (&Sfile_name_nondirectory);
1679
cd48b2c1a7a4 Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents: 1589
diff changeset
3343 defsubr (&Sunhandled_file_name_directory);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3344 defsubr (&Sfile_name_as_directory);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3345 defsubr (&Sdirectory_file_name);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3346 defsubr (&Smake_temp_name);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3347 defsubr (&Sexpand_file_name);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3348 defsubr (&Ssubstitute_in_file_name);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3349 defsubr (&Scopy_file);
1533
b86ef0432100 (Fmake_directory_internal): Renamed from Fmake_directory.
Richard M. Stallman <rms@gnu.org>
parents: 1377
diff changeset
3350 defsubr (&Smake_directory_internal);
686
bd3068742807 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
3351 defsubr (&Sdelete_directory);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3352 defsubr (&Sdelete_file);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3353 defsubr (&Srename_file);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3354 defsubr (&Sadd_name_to_file);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3355 #ifdef S_IFLNK
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3356 defsubr (&Smake_symbolic_link);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3357 #endif /* S_IFLNK */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3358 #ifdef VMS
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3359 defsubr (&Sdefine_logical_name);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3360 #endif /* VMS */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3361 #ifdef HPUX_NET
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3362 defsubr (&Ssysnetunam);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3363 #endif /* HPUX_NET */
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3364 defsubr (&Sfile_name_absolute_p);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3365 defsubr (&Sfile_exists_p);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3366 defsubr (&Sfile_executable_p);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3367 defsubr (&Sfile_readable_p);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3368 defsubr (&Sfile_writable_p);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3369 defsubr (&Sfile_symlink_p);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3370 defsubr (&Sfile_directory_p);
536
55d0073987d4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
3371 defsubr (&Sfile_accessible_directory_p);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3372 defsubr (&Sfile_modes);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3373 defsubr (&Sset_file_modes);
1763
65e858c07a8b (Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
parents: 1762
diff changeset
3374 defsubr (&Sset_default_file_modes);
65e858c07a8b (Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
parents: 1762
diff changeset
3375 defsubr (&Sdefault_file_modes);
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3376 defsubr (&Sfile_newer_than_file_p);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3377 defsubr (&Sinsert_file_contents);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3378 defsubr (&Swrite_region);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3379 defsubr (&Sverify_visited_file_modtime);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3380 defsubr (&Sclear_visited_file_modtime);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3381 defsubr (&Sset_visited_file_modtime);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3382 defsubr (&Sdo_auto_save);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3383 defsubr (&Sset_buffer_auto_saved);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3384 defsubr (&Srecent_auto_save_p);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3385
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3386 defsubr (&Sread_file_name_internal);
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3387 defsubr (&Sread_file_name);
689
45401d45581d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 686
diff changeset
3388
1204
567860ca77e0 * fileio.c (syms_of_fileio): Don't try to defsubr Sunix_sync
Jim Blandy <jimb@redhat.com>
parents: 1178
diff changeset
3389 #ifdef unix
689
45401d45581d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 686
diff changeset
3390 defsubr (&Sunix_sync);
1204
567860ca77e0 * fileio.c (syms_of_fileio): Don't try to defsubr Sunix_sync
Jim Blandy <jimb@redhat.com>
parents: 1178
diff changeset
3391 #endif
230
5eb609139f6f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3392 }