annotate src/fileio.c @ 844:047d37eb70d7

[xemacs-hg @ 2002-05-16 13:30:23 by ben] ui fixes for things that were bothering me bytecode.c, editfns.c, lisp.h, lread.c: Fix save-restriction to use markers rather than pseudo-markers (integers representing the amount of text on either side of the region). That way, all inserts are handled correctly, not just those inside old restriction. Add buffer argument to save_restriction_save(). process.c: Clean up very dirty and kludgy code that outputs into a buffer -- use proper unwind protects, etc. font-lock.c: Do save-restriction/widen around the function -- otherwise, incorrect results will ensue when a buffer has been narrowed before a call to e.g. `buffer-syntactic-context' -- something that happens quite often. fileio.c: Look for a handler for make-temp-name. window.c, winslots.h: Try to solve this annoying problem: have two frames displaying the buffer, in different places; in one, temporarily switch away to another buffer and then back -- and you've lost your position; it's reset to the other one in the other frame. My current solution involves window-level caches of buffers and points (also a cache for window-start); when set-window-buffer is called, it looks to see if the buffer was previously visited in the window, and if so, uses the most recent point at that time. (It's a marker, so it handles changes.) #### Note: It could be argued that doing it on the frame level would be better -- e.g. if you visit a buffer temporarily through a grep, and then go back to that buffer, you presumably want the grep's position rather than some previous position provided everything was in the same frame, even though the grep was in another window in the frame. However, doing it on the frame level fails when you have two windows on the same frame. Perhaps we keep both a window and a frame cache, and use the frame cache if there are no other windows on the frame showing the buffer, else the window's cache? This is probably something to be configurable using a specifier. Suggestions please please please? window.c: Clean up a bit code that deals with the annoyance of window-point vs. point. dialog.el: Function to ask a multiple-choice question, automatically choosing a dialog box or minibuffer representation as necessary. Generalized version of yes-or-no-p, y-or-n-p. files.el: Use get-user-response to ask "yes/no/diff" question when recovering. "diff" means that a diff is displayed between the current file and the autosave. (Converts/deconverts escape-quoted as necessary. No more complaints from you, Mr. Turnbull!) One known problem: when a dialog is used, it's modal, so you can't scroll the diff. Will fix soon. lisp-mode.el: If we're filling a string, don't treat semicolon as a comment, which would give very unfriendly results. Uses `buffer-syntactic-context'. simple.el: all changes back to the beginning. (Useful if you've saved the file in the middle of the changes.) simple.el: Add option kill-word-into-kill-ring, which controls whether words deleted with kill-word, backward-kill-word, etc. are "cut" into the kill ring, or "cleared" into nothingness. (My preference is the latter, by far. I'd almost go so far as suggesting we make it the default, as you can always select a word and then cut it if you want it cut.) menubar-items.el: Add option corresponding to kill-word-into-kill-ring.
author ben
date Thu, 16 May 2002 13:30:58 +0000
parents 6728e641994e
children e7ee5f8bde58
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* File IO for XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985-1988, 1992-1995 Free Software Foundation, Inc.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3 Copyright (C) 1996, 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Mule 2.0, FSF 19.30. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
23 /* More syncing: FSF Emacs 19.34.6 by Marc Paquette <marcpa@cam.org>
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
24 (Note: Sync messages from Marc Paquette may indicate
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
25 incomplete synching, so beware.) */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
26 /* Mule-ized completely except for the #if 0-code including decrypt-string
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
27 and encrypt-string. --ben 7-2-00 */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
28
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "buffer.h"
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
34 #include "device.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "events.h"
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
36 #include "file-coding.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #include "insdel.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "lstream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #include "redisplay.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 #include "sysdep.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #include "window.h" /* minibuf_level */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
43
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 #include "sysfile.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #include "sysproc.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #include "syspwd.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #include "systime.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #include "sysdir.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 #ifdef HPUX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 #include <netio.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 #ifdef HPUX_PRE_8_0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 #include <errnet.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 #endif /* HPUX_PRE_8_0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 #endif /* HPUX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
57 #if defined (WIN32_NATIVE) || defined (CYGWIN)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
58 #define WIN32_FILENAMES
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
59 #include "syswindows.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 #define IS_DRIVE(x) isalpha (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 /* Need to lower-case the drive letter, or else expanded
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 filenames will sometimes compare inequal, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 `expand-file-name' doesn't always down-case the drive letter. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 #define DRIVE_LETTER(x) tolower (x)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
65 #endif /* WIN32_NATIVE || CYGWIN */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 int lisp_to_time (Lisp_Object, time_t *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 Lisp_Object time_to_lisp (time_t);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 /* Nonzero during writing of auto-save files */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 static int auto_saving;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 /* Set by auto_save_1 to mode of original file so Fwrite_region_internal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 will create a new file with the same mode as the original */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 static int auto_save_mode_bits;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 /* Alist of elements (REGEXP . HANDLER) for file names
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 whose I/O is done with a special handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 Lisp_Object Vfile_name_handler_alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 /* Format for auto-save files */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 Lisp_Object Vauto_save_file_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 /* Lisp functions for translating file formats */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 Lisp_Object Qformat_decode, Qformat_annotate_function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 /* Functions to be called to process text properties in inserted file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 Lisp_Object Vafter_insert_file_functions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 /* Functions to be called to create text property annotations for file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 Lisp_Object Vwrite_region_annotate_functions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 /* During build_annotations, each time an annotation function is called,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 this holds the annotations made by the previous functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 Lisp_Object Vwrite_region_annotations_so_far;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 /* File name in which we write a list of all our auto save files. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 Lisp_Object Vauto_save_list_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
100 /* Prefix used to construct Vauto_save_list_file_name. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
101 Lisp_Object Vauto_save_list_file_prefix;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
102
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
103 /* When non-nil, it prevents auto-save list file creation. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
104 int inhibit_auto_save_session;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
105
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 int disable_auto_save_when_buffer_shrinks;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 Lisp_Object Vdirectory_sep_char;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 /* These variables describe handlers that have "already" had a chance
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 to handle the current operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 Vinhibit_file_name_handlers is a list of file name handlers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 Vinhibit_file_name_operation is the operation being handled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 If we try to handle that operation, we ignore those handlers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 static Lisp_Object Vinhibit_file_name_handlers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 static Lisp_Object Vinhibit_file_name_operation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
120 Lisp_Object Qfile_already_exists;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 Lisp_Object Qauto_save_hook;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 Lisp_Object Qauto_save_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 Lisp_Object Qauto_saving;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 Lisp_Object Qcar_less_than_car;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 Lisp_Object Qcompute_buffer_file_truename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 EXFUN (Frunning_temacs_p, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
132 /* DATA can be anything acceptable to signal_error ().
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
133 */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
134
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
135 DOESNT_RETURN
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
136 report_file_type_error (Lisp_Object errtype, Lisp_Object oserrmess,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
137 const CIntbyte *string, Lisp_Object data)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
138 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
139 struct gcpro gcpro1;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
140 Lisp_Object errdata = build_error_data (NULL, data);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
141
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
142 GCPRO1 (errdata);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
143 errdata = Fcons (build_msg_string (string),
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
144 Fcons (oserrmess, errdata));
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
145 signal_error_1 (errtype, errdata);
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
146 /* UNGCPRO; not reached */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
147 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
148
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
149 DOESNT_RETURN
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
150 report_error_with_errno (Lisp_Object errtype,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
151 const CIntbyte *string, Lisp_Object data)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
152 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
153 report_file_type_error (errtype, lisp_strerror (errno), string, data);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
154 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
155
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 /* signal a file error when errno contains a meaningful value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 DOESNT_RETURN
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
159 report_file_error (const CIntbyte *string, Lisp_Object data)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
161 report_error_with_errno (Qfile_error, string, data);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 /* Just like strerror(3), except return a lisp string instead of char *.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 The string needs to be converted since it may be localized.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
167 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 lisp_strerror (int errnum)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
171 Extbyte *ret = strerror (errnum);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
172 if (!ret)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
173 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
174 Intbyte ffff[99];
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
175 qxesprintf (ffff, "Unknown error %d", errnum);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
176 return build_intstring (ffff);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
177 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
178 return build_ext_string (ret, Qstrerror_encoding);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 close_file_unwind (Lisp_Object fd)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 if (CONSP (fd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 if (INTP (XCAR (fd)))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
187 retry_close (XINT (XCAR (fd)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 free_cons (XCONS (fd));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
192 retry_close (XINT (fd));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 delete_stream_unwind (Lisp_Object stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 Lstream_delete (XLSTREAM (stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 /* Restore point, having saved it as a marker. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 restore_point_unwind (Lisp_Object point_marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 BUF_SET_PT (current_buffer, marker_position (point_marker));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 return Fset_marker (point_marker, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 Lisp_Object Qexpand_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 Lisp_Object Qfile_truename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 Lisp_Object Qsubstitute_in_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 Lisp_Object Qdirectory_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 Lisp_Object Qfile_name_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 Lisp_Object Qfile_name_nondirectory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 Lisp_Object Qunhandled_file_name_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 Lisp_Object Qfile_name_as_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 Lisp_Object Qcopy_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 Lisp_Object Qmake_directory_internal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 Lisp_Object Qdelete_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 Lisp_Object Qdelete_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 Lisp_Object Qrename_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 Lisp_Object Qadd_name_to_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 Lisp_Object Qmake_symbolic_link;
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
229 Lisp_Object Qmake_temp_name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 Lisp_Object Qfile_exists_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 Lisp_Object Qfile_executable_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 Lisp_Object Qfile_readable_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 Lisp_Object Qfile_symlink_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 Lisp_Object Qfile_writable_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 Lisp_Object Qfile_directory_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 Lisp_Object Qfile_regular_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 Lisp_Object Qfile_accessible_directory_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 Lisp_Object Qfile_modes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 Lisp_Object Qset_file_modes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 Lisp_Object Qfile_newer_than_file_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 Lisp_Object Qinsert_file_contents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 Lisp_Object Qwrite_region;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 Lisp_Object Qverify_visited_file_modtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 Lisp_Object Qset_visited_file_modtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 /* If FILENAME is handled specially on account of its syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 return its handler function. Otherwise, return nil. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 DEFUN ("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 Return FILENAME's handler function for OPERATION, if it has one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 Otherwise, return nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 A file name is handled if one of the regular expressions in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 `file-name-handler-alist' matches it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 If OPERATION equals `inhibit-file-name-operation', then we ignore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 any handlers that are members of `inhibit-file-name-handlers',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 but we still do run any other handlers. This lets handlers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 use the standard functions without calling themselves recursively.
751
358bd84dc7ff [xemacs-hg @ 2002-02-13 12:55:38 by stephent]
stephent
parents: 707
diff changeset
259
358bd84dc7ff [xemacs-hg @ 2002-02-13 12:55:38 by stephent]
stephent
parents: 707
diff changeset
260 Otherwise, OPERATION is the name of a funcall'able function.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 (filename, operation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 /* This function does not GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 /* This function can be called during GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 /* This function must not munge the match data. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 Lisp_Object chain, inhibited_handlers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 if (EQ (operation, Vinhibit_file_name_operation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 inhibited_handlers = Vinhibit_file_name_handlers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 inhibited_handlers = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 EXTERNAL_LIST_LOOP (chain, Vfile_name_handler_alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 Lisp_Object elt = XCAR (chain);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 if (CONSP (elt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 Lisp_Object string = XCAR (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 if (STRINGP (string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 && (fast_lisp_string_match (string, filename) >= 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 Lisp_Object handler = XCDR (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 if (NILP (Fmemq (handler, inhibited_handlers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 return handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 call2_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 Lisp_Object result = call2 (fn, arg0, arg1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 CHECK_STRING (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 call2_check_string_or_nil (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 Lisp_Object result = call2 (fn, arg0, arg1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 if (!NILP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 CHECK_STRING (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 call3_check_string (Lisp_Object fn, Lisp_Object arg0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 Lisp_Object arg1, Lisp_Object arg2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 Lisp_Object result = call3 (fn, arg0, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 CHECK_STRING (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
326 Return the directory component in file name FILENAME.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
327 Return nil if FILENAME does not include a directory.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 Otherwise return a directory spec.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 Given a Unix syntax file name, returns a string ending in slash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
331 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
333 /* This function can GC. GC checked 2000-07-28 ben */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
334 /* This function synched with Emacs 21.0.103. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
335 Intbyte *beg;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
336 Intbyte *p;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
339 CHECK_STRING (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
343 handler = Ffind_file_name_handler (filename, Qfile_name_directory);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
345 return call2_check_string_or_nil (handler, Qfile_name_directory, filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 #ifdef FILE_SYSTEM_CASE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
348 filename = FILE_SYSTEM_CASE (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
350 beg = XSTRING_DATA (filename);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
351 /* XEmacs: no need to alloca-copy here */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
352 p = beg + XSTRING_LENGTH (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
354 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
355 #ifdef WIN32_FILENAMES
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
356 /* only recognise drive specifier at the beginning */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
357 && !(p[-1] == ':'
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
358 /* handle the "/:d:foo" and "/:foo" cases correctly */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
359 && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
360 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 #endif
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
362 ) p--;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 if (p == beg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 return Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
366 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 /* Expansion of "c:" to drive and default directory. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
368 if (p[-1] == ':')
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
370 Intbyte *res;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
371 Intbyte *wd = mswindows_getdcwd (toupper (*beg) - 'A' + 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
372
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
373 res = alloca_array (Intbyte,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
374 (wd ? qxestrlen (wd) : 0) + 10); /* go overboard */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
375 if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
376 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
377 qxestrncpy (res, beg, 2);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
378 beg += 2;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
379 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
380
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
381 if (wd)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
383 qxestrcat (res, wd);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
384 if (!IS_DIRECTORY_SEP (res[qxestrlen (res) - 1]))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
385 qxestrcat (res, (Intbyte *) "/");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 beg = res;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
387 p = beg + qxestrlen (beg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
389 if (wd)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
390 xfree (wd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
392
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
393 #if 0 /* No! This screws up efs, which calls file-name-directory on URL's
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
394 and expects the slashes to be left alone. This is here because of
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
395 an analogous call in FSF 21. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
396 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
397 Bytecount len = p - beg;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
398 Intbyte *newbeg = alloca_intbytes (len + 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
399 Lisp_Object return_me;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
400
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
401 qxestrncpy (newbeg, beg, len);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
402 newbeg[len] = '\0';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
403 newbeg = mswindows_canonicalize_filename (newbeg);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
404 return_me = build_intstring (newbeg);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
405 xfree (newbeg);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
406 return return_me;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
407 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
408 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
409 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 return make_string (beg, p - beg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
414 Return file name FILENAME sans its directory.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 For example, in a Unix-syntax file name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 this is everything after the last slash,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 or the entire name if it contains no slash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
419 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
421 /* This function can GC. GC checked 2000-07-28 ben */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
422 /* This function synched with Emacs 21.0.103. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
423 Intbyte *beg, *p, *end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
426 CHECK_STRING (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
430 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
432 return call2_check_string (handler, Qfile_name_nondirectory, filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
433
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
434 beg = XSTRING_DATA (filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
435 end = p = beg + XSTRING_LENGTH (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
437 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
438 #ifdef WIN32_FILENAMES
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
439 /* only recognise drive specifier at beginning */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
440 && !(p[-1] == ':'
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
441 /* handle the "/:d:foo" case correctly */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
442 && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 #endif
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
444 )
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
445 p--;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 return make_string (p, end - p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 Return a directly usable directory name somehow associated with FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 A `directly usable' directory name is one that may be used without the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 intervention of any file handler.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 If FILENAME is a directly usable file itself, return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 \(file-name-directory FILENAME).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 The `call-process' and `start-process' functions use this function to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 get a current directory to run processes in.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
459 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
461 /* This function can GC. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 return call2 (handler, Qunhandled_file_name_directory,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 return Ffile_name_directory (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
475 static Intbyte *
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
476 file_name_as_directory (Intbyte *out, Intbyte *in)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
478 /* This function cannot GC */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
479 int size = qxestrlen (in);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 if (size == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 out[0] = '.';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 out[1] = DIRECTORY_SEP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 out[2] = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
489 qxestrcpy (out, in);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 /* Append a slash if necessary */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 if (!IS_ANY_SEP (out[size-1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 out[size] = DIRECTORY_SEP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 out[size + 1] = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 return out;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 Return a string representing file FILENAME interpreted as a directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 This operation exists because a directory is also a file, but its name as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 a directory is different from its name as a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 The result can be used as the value of `default-directory'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 or passed as second argument to `expand-file-name'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 For a Unix-syntax file name, just appends a slash,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 except for (file-name-as-directory \"\") => \"./\".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
509 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
511 /* This function can GC. GC checked 2000-07-28 ben */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
512 Intbyte *buf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
515 CHECK_STRING (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
519 handler = Ffind_file_name_handler (filename, Qfile_name_as_directory);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
521 return call2_check_string (handler, Qfile_name_as_directory, filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
522
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
523 buf = alloca_intbytes (XSTRING_LENGTH (filename) + 10);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
524 return build_intstring (file_name_as_directory (buf, XSTRING_DATA (filename)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 * Convert from directory name to filename.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 * On UNIX, it's simple: just make sure there isn't a terminating /
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 * Value is nonzero if the string output is different from the input.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 static int
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
535 directory_file_name (const Intbyte *src, Intbyte *dst)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
537 /* This function cannot GC */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
538 long slen = qxestrlen (src);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 /* Process as Unix format: just remove any final slash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 But leave "/" unchanged; do not change it to "". */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
541 qxestrcpy (dst, src);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 if (slen > 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 && IS_DIRECTORY_SEP (dst[slen - 1])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
544 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 && !IS_ANY_SEP (dst[slen - 2])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
546 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 dst[slen - 1] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
553 Return the file name of the directory named DIRECTORY.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
554 This is the name of the file that holds the data for the directory.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 This operation exists because a directory is also a file, but its name as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 a directory is different from its name as a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 In Unix-syntax, this function just removes the final slash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 (directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
561 /* This function can GC. GC checked 2000-07-28 ben */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
562 Intbyte *buf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 CHECK_STRING (directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 #if 0 /* #### WTF? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 if (NILP (directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 return call2_check_string (handler, Qdirectory_file_name, directory);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
577 buf = (Intbyte *) alloca (XSTRING_LENGTH (directory) + 20);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
578 directory_file_name (XSTRING_DATA (directory), buf);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
579 return build_intstring (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 /* Fmake_temp_name used to be a simple wrapper around mktemp(), but it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 proved too broken for our purposes (it supported only 26 or 62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 unique names under some implementations). For example, this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 arbitrary limit broke generation of Gnus Incoming* files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 This implementation is better than what one usually finds in libc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 --hniksic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
590 static unsigned int temp_name_rand;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
591
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
593 Generate a temporary file name starting with PREFIX.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 The Emacs process number forms part of the result, so there is no
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 danger of generating a name being used by another process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 In addition, this function makes an attempt to choose a name that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 does not specify an existing file. To make this work, PREFIX should
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
599 be an absolute file name. A reasonable idiom is
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
600
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
601 \(make-temp-name (expand-file-name "myprefix" (temp-directory)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
602
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
603 which puts the file in the OS-specified temporary directory.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 (prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
607 static const char tbl[64] =
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
608 {
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 'A','B','C','D','E','F','G','H',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 'I','J','K','L','M','N','O','P',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 'Q','R','S','T','U','V','W','X',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 'Y','Z','a','b','c','d','e','f',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 'g','h','i','j','k','l','m','n',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 'o','p','q','r','s','t','u','v',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 'w','x','y','z','0','1','2','3',
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
616 '4','5','6','7','8','9','-','_'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
617 };
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 Bytecount len;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
620 Intbyte *p, *data;
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
621 Lisp_Object handler;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 CHECK_STRING (prefix);
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
624 handler = Ffind_file_name_handler (prefix, Qmake_temp_name);
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
625 if (!NILP (handler))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
626 return call2_check_string (handler, Qmake_temp_name, prefix);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 a bad idea because:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 1) It might change the prefix, so the resulting string might not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 begin with PREFIX. This violates the principle of least
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 surprise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 2) It breaks under many unforeseeable circumstances, such as with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 the code that uses (make-temp-name "") instead of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 (make-temp-name "./").
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
639 [[ 3) It might yield unexpected (to stat(2)) results in the presence
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
640 of EFS and file name handlers.]] Now that we check for a handler,
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
641 that's less of a concern. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 len = XSTRING_LENGTH (prefix);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
644 data = alloca_intbytes (len + 7);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 memcpy (data, XSTRING_DATA (prefix), len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 p = data + len;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
647 p[6] = '\0';
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 /* VAL is created by adding 6 characters to PREFIX. The first three
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 are the PID of this process, in base 64, and the second three are
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
651 a pseudo-random number seeded from process startup time. This
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
652 ensures 262144 unique file names per PID per PREFIX per machine. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
653
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
654 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
655 unsigned int pid = (unsigned int) qxe_getpid ();
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
656 *p++ = tbl[(pid >> 0) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
657 *p++ = tbl[(pid >> 6) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
658 *p++ = tbl[(pid >> 12) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
659 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 /* Here we try to minimize useless stat'ing when this function is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 invoked many times successively with the same PREFIX. We achieve
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
663 this by using a very pseudo-random number generator to generate
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
664 file names unique to this process, with a very long cycle. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 struct stat ignored;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
669
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
670 p[0] = tbl[(temp_name_rand >> 0) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
671 p[1] = tbl[(temp_name_rand >> 6) & 63];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
672 p[2] = tbl[(temp_name_rand >> 12) & 63];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 /* Poor man's congruential RN generator. Replace with ++count
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 for debugging. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
676 temp_name_rand += 25229;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
677 temp_name_rand %= 225307;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
681 if (qxe_stat (data, &ignored) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 /* We want to return only if errno is ENOENT. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 if (errno == ENOENT)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
685 return make_string (data, len + 6);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 /* The error here is dubious, but there is little else we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 can do. The alternatives are to return nil, which is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 as bad as (and in many cases worse than) throwing the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 error, or to ignore the error, which will likely result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 in inflooping. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 report_file_error ("Cannot create temporary name for prefix",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
693 prefix);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 return Qnil; /* not reached */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
700
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 Convert filename NAME to absolute, and canonicalize it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
705 the current buffer's value of `default-directory' is used.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 File name components that are `.' are removed, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 so are file name components followed by `..', along with the `..' itself;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 note that these simplifications are done without checking the resulting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 file names in the file system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 An initial `~/' expands to your home directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 An initial `~USER/' expands to USER's home directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 See also the function `substitute-in-file-name'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 (name, default_directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
716 /* This function can GC. GC-checked 2000-11-18.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
717 This function synched with Emacs 21.0.103. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
718 Intbyte *nm;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
719
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
720 Intbyte *newdir, *p, *o;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 int tlen;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
722 Intbyte *target;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
723 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 int drive = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 int collapse_newdir = 1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
726 /* XEmacs note: This concerns the special '/:' syntax for preventing
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
727 wildcards and such. We don't support this currently but I'm
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
728 keeping the code here in case we do. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
729 int is_escaped = 0;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
730 #endif
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
731 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 struct passwd *pw;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
733 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 int length;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
735 Lisp_Object handler = Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
736 struct gcpro gcpro1, gcpro2, gcpro3;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
737
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
738 /* both of these get set below */
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
739 GCPRO3 (name, default_directory, handler);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 CHECK_STRING (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 handler = Ffind_file_name_handler (name, Qexpand_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 if (!NILP (handler))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
747 RETURN_UNGCPRO (call3_check_string (handler, Qexpand_file_name,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
748 name, default_directory));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 if (NILP (default_directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 default_directory = current_buffer->directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 if (! STRINGP (default_directory))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
754 #ifdef WIN32_NATIVE
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
755 default_directory = build_string ("C:\\");
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
756 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 default_directory = build_string ("/");
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
758 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 if (!NILP (default_directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 if (!NILP (handler))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
764 RETURN_UNGCPRO (call3 (handler, Qexpand_file_name,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
765 name, default_directory));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 o = XSTRING_DATA (default_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 /* Make sure DEFAULT_DIRECTORY is properly expanded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 It would be better to do this down below where we actually use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 default_directory. Unfortunately, calling Fexpand_file_name recursively
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 could invoke GC, and the strings might be relocated. This would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 be annoying because we have pointers into strings lying around
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 that would need adjusting, and people would add new pointers to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 the code and forget to adjust them, resulting in intermittent bugs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 Putting this call here avoids all that crud.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 The EQ test avoids infinite recursion. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 if (! NILP (default_directory) && !EQ (default_directory, name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 /* Save time in some common cases - as long as default_directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 is not relative, it can be canonicalized with name below (if it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 is needed at all) without requiring it to be expanded now. */
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
784 #ifdef WIN32_FILENAMES
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
785 /* Detect Windows file names with drive specifiers. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 /* Detect Windows file names in UNC format. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
789 #endif /* not WIN32_FILENAMES */
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
790 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 /* Detect Unix absolute file names (/... alone is not absolute on
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
792 Windows). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 && ! (IS_DIRECTORY_SEP (o[0]))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
794 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 )
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
796
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
797 default_directory = Fexpand_file_name (default_directory, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 #ifdef FILE_SYSTEM_CASE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 name = FILE_SYSTEM_CASE (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 into name should be safe during all of this, though. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 nm = XSTRING_DATA (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
807 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 /* We will force directory separators to be either all \ or /, so make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 a local copy to modify, even if there ends up being no change. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
810 nm = qxestrcpy (alloca_intbytes (qxestrlen (nm) + 1), nm);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
811
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
812 /* Note if special escape prefix is present, but remove for now. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
813 if (nm[0] == '/' && nm[1] == ':')
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
814 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
815 is_escaped = 1;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
816 nm += 2;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
817 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 /* Find and remove drive specifier if present; this makes nm absolute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 even if the rest of the name appears to be relative. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
822 Intbyte *colon = qxestrrchr (nm, ':');
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 if (colon)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
825 {
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 /* Only recognize colon as part of drive specifier if there is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 single alphabetic character preceding the colon (and if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 character before the drive letter, if present, is a directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 separator); this is to support the remote system syntax used by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 ange-ftp, and the "po:username" syntax for POP mailboxes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 look_again:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 if (nm == colon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 nm++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 else if (IS_DRIVE (colon[-1])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 drive = colon[-1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 nm = colon + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 while (--colon >= nm)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 if (colon[0] == ':')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 goto look_again;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
846 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 /* If we see "c://somedir", we want to strip the first slash after the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 colon when stripping the drive letter. Otherwise, this expands to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 "//somedir". */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 nm++;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
854 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
856 #ifdef WIN32_FILENAMES
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
857 /* Discard any previous drive specifier if nm is now in UNC format. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
858 if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
859 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
860 drive = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
861 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
862 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
863
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 /* If nm is absolute, look for /./ or /../ sequences; if none are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 found, we can probably return right away. We will avoid allocating
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 a new string if name is already fully expanded. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 if (
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 IS_DIRECTORY_SEP (nm[0])
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
869 #ifdef WIN32_NATIVE
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
870 && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 /* If it turns out that the filename we want to return is just a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 suffix of FILENAME, we don't need to go through and edit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 things; we just need to construct a new string using data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 starting at the middle of FILENAME. If we set lose to a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 non-zero value, that means we've discovered that we can't do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 that cool trick. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 int lose = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 p = nm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 while (*p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 /* Since we know the name is absolute, we can assume that each
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 element starts with a "/". */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 /* "." and ".." are hairy. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 if (IS_DIRECTORY_SEP (p[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 && p[1] == '.'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 && (IS_DIRECTORY_SEP (p[2])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 || p[2] == 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 || p[3] == 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 lose = 1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
896 /* We want to replace multiple `/' in a row with a single
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
897 slash. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
898 else if (p > nm
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
899 && IS_DIRECTORY_SEP (p[0])
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
900 && IS_DIRECTORY_SEP (p[1]))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
901 lose = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 if (!lose)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 {
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
906 #ifdef WIN32_FILENAMES
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
907 if (drive || IS_DIRECTORY_SEP (nm[1]))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
909 Intbyte *newnm;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
910
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
911 if (IS_DIRECTORY_SEP (nm[1]))
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
912 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
913 newnm = mswindows_canonicalize_filename (nm);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
914 if (qxestrcmp (newnm, XSTRING_DATA (name)) != 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
915 name = build_intstring (newnm);
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
916 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
917 else
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
918 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
919 /* drive must be set, so this is okay */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
920 newnm = mswindows_canonicalize_filename (nm - 2);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
921 if (qxestrcmp (newnm, XSTRING_DATA (name)) != 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
922 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
923 name = build_intstring (newnm);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
924 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
925 XSTRING_DATA (name)[1] = ':';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
926 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
927 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
928 xfree (newnm);
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
929 RETURN_UNGCPRO (name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
931 #endif /* WIN32_FILENAMES */
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
932 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 if (nm == XSTRING_DATA (name))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
934 RETURN_UNGCPRO (name);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
935 RETURN_UNGCPRO (build_intstring (nm));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
936 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 /* At this point, nm might or might not be an absolute file name. We
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 need to expand ~ or ~user if present, otherwise prefix nm with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 default_directory if nm is not absolute, and finally collapse /./
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 and /foo/../ sequences.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 We set newdir to be the appropriate prefix if one is needed:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 - the relevant user directory if nm starts with ~ or ~user
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 - the specified drive's working dir (DOS/NT only) if nm does not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 start with /
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 - the value of default_directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 Note that these prefixes are not guaranteed to be absolute (except
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 for the working dir of a drive). Therefore, to ensure we always
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 return an absolute name, if the final prefix is not absolute we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 append it to the current working directory. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 newdir = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 if (nm[0] == '~') /* prefix ~ */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 if (IS_DIRECTORY_SEP (nm[1])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 || nm[1] == 0) /* ~ by itself */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
963 Intbyte *homedir = get_home_directory ();
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
964
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
965 if (!homedir)
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
966 newdir = (Intbyte *) "";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
968 newdir = homedir;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 nm++;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
971 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 collapse_newdir = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 else /* ~user/filename */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 DO_NOTHING;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
979 o = (Intbyte *) alloca (p - nm + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
980 memcpy (o, nm, p - nm);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 o [p - nm] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 462
diff changeset
983 /* #### While NT is single-user (for the moment) you still
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 462
diff changeset
984 can have multiple user profiles users defined, each with
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 462
diff changeset
985 its HOME. So maybe possibly we should think about handling
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 462
diff changeset
986 ~user. --ben */
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 462
diff changeset
987 #ifndef WIN32_NATIVE
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
988 #ifdef CYGWIN
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
989 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
990 Intbyte *user;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
991
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
992 if ((user = user_login_name (NULL)) != NULL)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
993 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
994 /* Does the user login name match the ~name? */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
995 if (qxestrcmp (user, o + 1) == 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
996 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
997 newdir = get_home_directory ();
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
998 nm = p;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
999 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1000 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1001 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1002 if (!newdir)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1004 #endif /* CYGWIN */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 occurring in it. (It can call select()). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 slow_down_interrupts ();
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1008 pw = (struct passwd *) qxe_getpwnam (o + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 speed_up_interrupts ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 if (pw)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1012 newdir = (Intbyte *) pw->pw_dir;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 nm = p;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1014 /* FSF: if WIN32_NATIVE, collapse_newdir = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1015 not possible here. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1017 #ifdef CYGWIN
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 #endif
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1020 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 /* If we don't find a user of that name, leave the name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 unchanged; don't move nm forward to p. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1027 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 /* On DOS and Windows, nm is absolute if a drive name was specified;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 use the drive's current directory as the prefix if needed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 if (!newdir && drive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 {
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1032 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 /* Get default directory if needed to make nm absolute. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 if (!IS_DIRECTORY_SEP (nm[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1036 Intbyte *newcwd = mswindows_getdcwd (toupper (drive) - 'A' + 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1037 if (newcwd)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1038 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1039 INTBYTE_STRING_TO_ALLOCA (newcwd, newdir);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1040 xfree (newcwd);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1041 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1042 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 newdir = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1045 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 if (!newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 /* Either nm starts with /, or drive isn't mounted. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1049 newdir = (Intbyte *) alloca (4);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 newdir[0] = DRIVE_LETTER (drive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 newdir[1] = ':';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 newdir[2] = '/';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 newdir[3] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1056 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 /* Finally, if no prefix has been specified and nm is not absolute,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 then it must be expanded relative to default_directory. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 if (1
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1062 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 /* /... alone is not absolute on DOS and Windows. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 && !IS_DIRECTORY_SEP (nm[0])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1065 #endif
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1066 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 && !newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 newdir = XSTRING_DATA (default_directory);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1072 #ifdef WIN32_FILENAMES
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1073 /* Note if special escape prefix is present, but remove for now. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1074 if (newdir[0] == '/' && newdir[1] == ':')
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1075 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1076 is_escaped = 1;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1077 newdir += 2;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1078 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1079 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1082 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 if (newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 /* First ensure newdir is an absolute name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 if (
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1087 /* Detect Windows file names with drive specifiers. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 ! (IS_DRIVE (newdir[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 /* Detect Windows file names in UNC format. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1092 /* XEmacs: added these two lines: Detect drive spec by itself */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 && ! (IS_DEVICE_SEP (newdir[1]) && newdir[2] == 0)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1094 /* Detect unix format. */
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1095 #ifndef WIN32_NATIVE
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1096 && ! (IS_DIRECTORY_SEP (newdir[0]))
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1097 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 /* Effectively, let newdir be (expand-file-name newdir cwd).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 Because of the admonition against calling expand-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 when we have pointers into lisp strings, we accomplish this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 indirectly by prepending newdir to nm if necessary, and using
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 cwd (or the wd of newdir's drive) as the new newdir. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 drive = newdir[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 newdir += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 if (!IS_DIRECTORY_SEP (nm[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1113 Intbyte *tmp = (Intbyte *) alloca (qxestrlen (newdir) +
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1114 qxestrlen (nm) + 2);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1115 file_name_as_directory (tmp, newdir);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1116 qxestrcat (tmp, nm);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 nm = tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 if (drive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 {
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1121 #ifdef WIN32_NATIVE
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1122 Intbyte *newcwd = mswindows_getdcwd (toupper (drive) - 'A' + 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1123 if (newcwd)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1124 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1125 INTBYTE_STRING_TO_ALLOCA (newcwd, newdir);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1126 xfree (newcwd);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1127 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1128 else
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1129 #endif
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1130 INTBYTE_STRING_TO_ALLOCA ((Intbyte *) "/", newdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1133 INTBYTE_STRING_TO_ALLOCA (get_initial_directory (0, 0), newdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 /* Strip off drive name from prefix, if present. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 drive = newdir[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 newdir += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 /* Keep only a prefix from newdir if nm starts with slash
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1144 (//server/share for UNC, nothing otherwise). */
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1145 if (IS_DIRECTORY_SEP (nm[0])
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1146 #ifndef WIN32_NATIVE
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1147 && IS_DIRECTORY_SEP (nm[1])
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1148 #endif
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1149 && collapse_newdir)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 {
664
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 657
diff changeset
1153 newdir =
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1154 (Intbyte *)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1155 qxestrcpy ((Intbyte *) alloca (qxestrlen (newdir) + 1),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1156 newdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 p = newdir + 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 *p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 else
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1164 newdir = (Intbyte *) "";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1167 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 if (newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 /* Get rid of any slash at the end of newdir, unless newdir is
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1172 just / or // (an incomplete UNC name). */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1173 length = qxestrlen (newdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1175 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1180 Intbyte *temp = (Intbyte *) alloca (length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 memcpy (temp, newdir, length - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 temp[length - 1] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 newdir = temp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 tlen = length + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 tlen = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 /* Now concatenate the directory and name to new space in the stack frame */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1191 tlen += qxestrlen (nm) + 1;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1192 #ifdef WIN32_FILENAMES
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1193 /* Reserve space for drive specifier and escape prefix, since either
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1194 or both may need to be inserted. (The Microsoft x86 compiler
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 produces incorrect code if the following two lines are combined.) */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1196 target = (Intbyte *) alloca (tlen + 4);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1197 target += 4;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1198 #else /* not WIN32_FILENAMES */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1199 target = (Intbyte *) alloca (tlen);
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1200 #endif /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 *target = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 if (newdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1206 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1207 #ifdef WIN32_FILENAMES
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1208 /* If newdir is effectively "C:/", then the drive letter will have
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1209 been stripped and newdir will be "/". Concatenating with an
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1210 absolute directory in nm produces "//", which will then be
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1211 incorrectly treated as a network share. Ignore newdir in
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1212 this case (keeping the drive letter). */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1213 if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1214 && newdir[1] == '\0'))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1215 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1216 qxestrcpy (target, newdir);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1217 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1219 file_name_as_directory (target, newdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1222 qxestrcat (target, nm);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1226 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1227 appear. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 p = target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 o = target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 while (*p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 if (!IS_DIRECTORY_SEP (*p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 *o++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 else if (IS_DIRECTORY_SEP (p[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 && p[1] == '.'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 && (IS_DIRECTORY_SEP (p[2])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 || p[2] == 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 /* If "/." is the entire filename, keep the "/". Otherwise,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 just delete the whole "/.". */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 if (o == target && p[2] == '\0')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 *o++ = *p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 p += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 /* `/../' is the "superroot" on certain file systems. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 && o != target
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 /* Keep initial / only if this is the whole name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 ++o;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 p += 3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1261 else if (p > target
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1262 && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1263 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1264 /* Collapse multiple `/' in a row. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1265 *o++ = *p++;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1266 while (IS_DIRECTORY_SEP (*p))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1267 ++p;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1268 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 *o++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1275 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 /* At last, set drive name, except for network file name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 if (drive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 target -= 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 target[0] = DRIVE_LETTER (drive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 target[1] = ':';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1283 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1288 #endif
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1289 /* Reinsert the escape prefix if required. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1290 if (is_escaped)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1291 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1292 target -= 2;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1293 target[0] = '/';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1294 target[1] = ':';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1295 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1296
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1297 *o = '\0';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1298
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1299 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1300 Intbyte *newtarget = mswindows_canonicalize_filename (target);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1301 Lisp_Object result = build_intstring (newtarget);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1302 xfree (newtarget);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1303
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1304 RETURN_UNGCPRO (result);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1305 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1306 #else /* not WIN32_FILENAMES */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1307 RETURN_UNGCPRO (make_string (target, o - target));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1308 #endif /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1312 Return the canonical name of FILENAME.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1313 Second arg DEFAULT is directory to start with if FILENAME is relative
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 (does not start with slash); if DEFAULT is nil or missing,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1315 the current buffer's value of `default-directory' is used.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 No component of the resulting pathname will be a symbolic link, as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 in the realpath() function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 (filename, default_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1321 /* This function can GC. GC checked 2000-07-28 ben. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 Lisp_Object expanded_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 expanded_name = Fexpand_file_name (filename, default_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 if (!STRINGP (expanded_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 GCPRO1 (expanded_name);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1333
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1334 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1335 Lisp_Object handler =
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1336 Ffind_file_name_handler (expanded_name, Qfile_truename);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1337
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1338 if (!NILP (handler))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1339 RETURN_UNGCPRO
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1340 (call2_check_string (handler, Qfile_truename, expanded_name));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1341 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1344 Intbyte resolved_path[PATH_MAX];
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1345 Bytecount elen = XSTRING_LENGTH (expanded_name);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1346 Intbyte *path;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1347 Intbyte *p;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1348
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1349 LISP_STRING_TO_ALLOCA (expanded_name, path);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 p = path;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1351
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 /* Try doing it all at once. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1353 if (!qxe_realpath (path, resolved_path))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 /* Didn't resolve it -- have to do it one component at a time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 /* "realpath" is a typically useless, stupid un*x piece of crap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 It claims to return a useful value in the "error" case, but since
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 there is no indication provided of how far along the pathname
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 the function went before erring, there is no way to use the
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1360 partial result returned. What a piece of junk.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1361
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1362 The above comment refers to historical versions of
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1363 realpath(). The Unix98 specs state:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1364
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1365 "On successful completion, realpath() returns a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1366 pointer to the resolved name. Otherwise, realpath()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1367 returns a null pointer and sets errno to indicate the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1368 error, and the contents of the buffer pointed to by
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1369 resolved_name are undefined."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1370
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1371 Since we depend on undocumented semantics of various system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1372 realpath()s, we just use our own version in realpath.c. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1375 Intbyte *pos;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1376
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1377 #ifdef WIN32_FILENAMES
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1378 if (IS_DRIVE (p[0]) && IS_DEVICE_SEP (p[1])
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1379 && IS_DIRECTORY_SEP (p[2]))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1380 /* don't test c: on windows */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1381 p = p+2;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1382 else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1383 /* start after // */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1384 p = p+1;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1385 #endif
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1386 for (pos = p + 1; pos < path + elen; pos++)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1387 if (IS_DIRECTORY_SEP (*pos))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1388 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1389 *(p = pos) = 0;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1390 break;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1391 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1392 if (p != pos)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1393 p = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1395 if (qxe_realpath (path, resolved_path))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 if (p)
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1398 *p = DIRECTORY_SEP;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 else if (errno == ENOENT || errno == EACCES)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 /* Failed on this component. Just tack on the rest of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 the string and we are done. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1407 int rlen = qxestrlen (resolved_path);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 /* "On failure, it returns NULL, sets errno to indicate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 the error, and places in resolved_path the absolute pathname
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 of the path component which could not be resolved." */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1412
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1413 if (p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 int plen = elen - (p - path);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1417 if (rlen > 1 && IS_DIRECTORY_SEP (resolved_path[rlen - 1]))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 rlen = rlen - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 if (plen + rlen + 1 > countof (resolved_path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 goto toolong;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1423 resolved_path[rlen] = DIRECTORY_SEP;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1434 Lisp_Object resolved_name;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1435 int rlen = qxestrlen (resolved_path);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1436 if (elen > 0 && IS_DIRECTORY_SEP (string_byte (expanded_name, elen - 1))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1437 && !(rlen > 0 && IS_DIRECTORY_SEP (resolved_path[rlen - 1])))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 if (rlen + 1 > countof (resolved_path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 goto toolong;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1441 resolved_path[rlen++] = DIRECTORY_SEP;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1442 resolved_path[rlen] = '\0';
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1444 resolved_name = make_string (resolved_path, rlen);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1445 RETURN_UNGCPRO (resolved_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 toolong:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 errno = ENAMETOOLONG;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 lose:
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1452 report_file_error ("Finding truename", expanded_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1454 RETURN_UNGCPRO (Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 Substitute environment variables referred to in FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 `$FOO' where FOO is an environment variable name means to substitute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 the value of that variable. The variable name should be terminated
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1462 with a character, not a letter, digit or underscore; otherwise, enclose
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 the entire variable name in braces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 If `/~' appears, all of FILENAME through that `/' is discarded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1466 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1468 /* This function can GC. GC checked 2000-07-28 ben. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1469 Intbyte *nm;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1470
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1471 Intbyte *s, *p, *o, *x, *endp;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1472 Intbyte *target = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 int total = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 int substituted = 0;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1475 Intbyte *xnm;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1478 CHECK_STRING (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 call the corresponding file handler. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1482 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 return call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1485 filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1486
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1487 nm = XSTRING_DATA (filename);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1488 endp = nm + XSTRING_LENGTH (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 /* If /~ or // appears, discard everything through first slash. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 for (p = nm; p != endp; p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 if ((p[0] == '~'
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1495 #if defined (WIN32_FILENAMES)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
1496 /* // at start of file name is meaningful in WindowsNT systems */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1498 #else /* not (WIN32_FILENAMES) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 || IS_DIRECTORY_SEP (p[0])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1500 #endif /* not (WIN32_FILENAMES) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 && p != nm
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 && (IS_DIRECTORY_SEP (p[-1])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 nm = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 substituted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1508 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 /* see comment in expand-file-name about drive specifiers */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 else if (IS_DRIVE (p[0]) && p[1] == ':'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 && p > nm && IS_DIRECTORY_SEP (p[-1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 nm = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 substituted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1516 #endif /* WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 /* See if any variables are substituted into the string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 and find the total length of their values in `total' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 for (p = nm; p != endp;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 if (*p != '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 if (p == endp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 goto badsubst;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 else if (*p == '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 /* "$$" means a single "$" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 total -= 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 substituted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 else if (*p == '{')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 o = ++p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 while (p != endp && *p != '}') p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 if (*p != '}') goto missingclose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 s = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 o = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 while (p != endp && (isalnum (*p) || *p == '_')) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 s = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 /* Copy out the variable name */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1553 target = (Intbyte *) alloca (s - o + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1554 qxestrncpy (target, o, s - o);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 target[s - o] = 0;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1556 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 strupr (target); /* $home == $HOME etc. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1558 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 /* Get variable value */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1561 o = egetenv ((CIntbyte *) target);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 if (!o) goto badvar;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1563 total += qxestrlen (o);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 substituted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 if (!substituted)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1568 return filename;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1569
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1570 /* If substitution required, recopy the filename and do it */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 /* Make space in stack frame for the new copy */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1572 xnm = (Intbyte *) alloca (XSTRING_LENGTH (filename) + total + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 x = xnm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 /* Copy the rest of the name through, replacing $ constructs with values */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 for (p = nm; *p;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 if (*p != '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 *x++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 if (p == endp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 goto badsubst;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 else if (*p == '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 *x++ = *p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 else if (*p == '{')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 o = ++p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 while (p != endp && *p != '}') p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 if (*p != '}') goto missingclose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 s = p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 o = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 while (p != endp && (isalnum (*p) || *p == '_')) p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 s = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 /* Copy out the variable name */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1604 target = (Intbyte *) alloca (s - o + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1605 qxestrncpy (target, o, s - o);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 target[s - o] = 0;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1607 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 strupr (target); /* $home == $HOME etc. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1609 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 /* Get variable value */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1612 o = egetenv ((CIntbyte *) target);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 if (!o)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 goto badvar;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1616 qxestrcpy (x, o);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1617 x += qxestrlen (o);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 *x = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 /* If /~ or // appears, discard everything through first slash. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 for (p = xnm; p != x; p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 if ((p[0] == '~'
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1626 #if defined (WIN32_FILENAMES)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1628 #else /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 || IS_DIRECTORY_SEP (p[0])
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1630 #endif /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 /* don't do p[-1] if that would go off the beginning --jwz */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 xnm = p;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
1635 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 else if (IS_DRIVE (p[0]) && p[1] == ':'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 && p > nm && IS_DIRECTORY_SEP (p[-1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 xnm = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 return make_string (xnm, x - xnm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 badsubst:
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1644 syntax_error ("Bad format environment-variable substitution", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 missingclose:
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1646 syntax_error ("Missing \"}\" in environment-variable substitution",
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1647 filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 badvar:
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1649 syntax_error_2 ("Substituting nonexistent environment variable",
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1650 filename, build_intstring (target));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
1652 RETURN_NOT_REACHED (Qnil)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 /* A slightly faster and more convenient way to get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 (directory-file-name (expand-file-name FOO)). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1661 /* This function can call Lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 abspath = Fexpand_file_name (filename, defdir);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 /* Remove final slash, if any (unless path is root).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 stat behaves differently depending! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 if (XSTRING_LENGTH (abspath) > 1
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1670 && IS_DIRECTORY_SEP (string_byte (abspath, XSTRING_LENGTH (abspath) - 1))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1671 && !IS_DEVICE_SEP (string_byte (abspath, XSTRING_LENGTH (abspath) - 2)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 /* We cannot take shortcuts; they might be wrong for magic file names. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 abspath = Fdirectory_file_name (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 return abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 /* Signal an error if the file ABSNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 If INTERACTIVE is nonzero, ask the user whether to proceed,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 and bypass the error if the user says to go ahead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 QUERYSTRING is a name for the action that is being considered
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 to alter the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 *STATPTR is used to store the stat information if the file exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 If the file does not exist, STATPTR->st_mode is set to 0. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 static void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1687 barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 int interactive, struct stat *statptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1690 /* This function can call Lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 struct stat statbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 /* stat is a good way to tell whether the file exists,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 regardless of what access permissions it has. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1695 if (qxe_stat (XSTRING_DATA (absname), &statbuf) >= 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 if (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 Lisp_Object prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1704 prompt =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1705 emacs_sprintf_string
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1706 (CGETTEXT ("File %s already exists; %s anyway? "),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1707 XSTRING_DATA (absname), CGETTEXT (querystring));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 GCPRO1 (prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 tem = call1 (Qyes_or_no_p, prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 tem = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 if (NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 Fsignal (Qfile_already_exists,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1718 list2 (build_msg_string ("File already exists"),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 absname));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 if (statptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 *statptr = statbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 if (statptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 statptr->st_mode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 DEFUN ("copy-file", Fcopy_file, 2, 4,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 "fCopy file: \nFCopy %s to file: \np\nP", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1733 Copy FILENAME to NEWNAME. Both args must be strings.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 Signals a `file-already-exists' error if file NEWNAME already exists,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 A number as third arg means request confirmation if NEWNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 This is what happens in interactive use with M-x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 Fourth arg KEEP-TIME non-nil means give the new file the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 last-modified time as the old one. (This works on only some systems.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 A prefix arg makes KEEP-TIME non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 (filename, newname, ok_if_already_exists, keep_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1744 /* This function can call Lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 int ifd, ofd, n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 char buf[16 * 1024];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 struct stat st, out_st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 /* Lisp_Object args[6]; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 int input_file_statable_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 GCPRO2 (filename, newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 CHECK_STRING (newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 newname = Fexpand_file_name (newname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 /* If the input file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 handler = Ffind_file_name_handler (filename, Qcopy_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 /* Likewise for output file name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 handler = Ffind_file_name_handler (newname, Qcopy_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 return call5 (handler, Qcopy_file, filename, newname,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 ok_if_already_exists, keep_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 /* When second argument is a directory, copy the file into it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 if (!NILP (Ffile_directory_p (newname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 Lisp_Object args[3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 int i = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 args[0] = newname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 args[1] = Qnil; args[2] = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 NGCPRO1 (*args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 ngcpro1.nvars = 3;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1786 if (!IS_DIRECTORY_SEP (string_byte (newname,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1787 XSTRING_LENGTH (newname) - 1)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1788
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1789 args[i++] = Fchar_to_string (Vdirectory_sep_char);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 args[i++] = Ffile_name_nondirectory (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 newname = Fconcat (i, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 barf_or_query_if_file_exists (newname, "copy to it",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 INTP (ok_if_already_exists), &out_st);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1799 else if (qxe_stat (XSTRING_DATA (newname), &out_st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 out_st.st_mode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1802 ifd = qxe_interruptible_open (XSTRING_DATA (filename),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1803 O_RDONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 if (ifd < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1805 report_file_error ("Opening input file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 record_unwind_protect (close_file_unwind, make_int (ifd));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 /* We can only copy regular files and symbolic links. Other files are not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 copyable by us. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1811 input_file_statable_p = (qxe_fstat (ifd, &st) >= 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1813 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 if (out_st.st_mode != 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 errno = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 report_file_error ("Input and output files are the same",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1819 list3 (Qunbound, filename, newname));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 #if defined (S_ISREG) && defined (S_ISLNK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 if (input_file_statable_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 if (!(S_ISREG (st.st_mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 #ifdef S_ISCHR
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 && !(S_ISCHR (st.st_mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 && !(S_ISLNK (st.st_mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 #if defined (EISDIR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 /* Get a better looking error message. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 errno = EISDIR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 #endif /* EISDIR */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1837 report_file_error ("Non-regular file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 #endif /* S_ISREG && S_ISLNK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1842 ofd = qxe_open (XSTRING_DATA (newname),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1843 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 if (ofd < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1845 report_file_error ("Opening output file", newname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 record_unwind_protect (close_file_unwind, ofd_locative);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 if (write_allowing_quit (ofd, buf, n) != n)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1855 report_file_error ("I/O error", newname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 /* Closing the output clobbers the file times on some systems. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1859 if (retry_close (ofd) < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1860 report_file_error ("I/O error", newname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 if (input_file_statable_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1864 if (!NILP (keep_time))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1865 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1866 EMACS_TIME atime, mtime;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1867 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1868 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
592
4f6ba8f1fb3d [xemacs-hg @ 2001-05-31 12:03:37 by adrian]
adrian
parents: 563
diff changeset
1869 if (set_file_times (newname, atime, mtime))
4f6ba8f1fb3d [xemacs-hg @ 2001-05-31 12:03:37 by adrian]
adrian
parents: 563
diff changeset
1870 report_file_error ("I/O error", list1 (newname));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1871 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1872 qxe_chmod (XSTRING_DATA (newname), st.st_mode & 07777);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 /* We'll close it by hand */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 XCAR (ofd_locative) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 /* Close ifd */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1879 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 Create a directory. One argument, a file name string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 (dirname_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 struct gcpro gcpro1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1894 DECLARE_EISTRING (dir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 CHECK_STRING (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 dirname_ = Fexpand_file_name (dirname_, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 GCPRO1 (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 return (call2 (handler, Qmake_directory_internal, dirname_));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1905 eicpy_lstr (dir, dirname_);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1906 if (eigetch_char (dir, eicharlen (dir) - 1) == '/')
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1907 eidel (dir, eilen (dir) - 1, -1, 1, -1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1908
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1909 if (qxe_mkdir (eidata (dir), 0777) != 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1910 report_file_error ("Creating directory", dirname_);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 Delete a directory. One argument, a file name or directory name string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 (dirname_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 CHECK_STRING (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 GCPRO1 (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 dirname_ = Fexpand_file_name (dirname_, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 dirname_ = Fdirectory_file_name (dirname_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 return (call2 (handler, Qdelete_directory, dirname_));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1935 if (qxe_rmdir (XSTRING_DATA (dirname_)) != 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1936 report_file_error ("Removing directory", dirname_);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1942 Delete the file named FILENAME (a string).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1943 If FILENAME has multiple names, it continues to exist with the other names.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 GCPRO1 (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 handler = Ffind_file_name_handler (filename, Qdelete_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 return call2 (handler, Qdelete_file, filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
1960 if (0 > qxe_unlink (XSTRING_DATA (filename)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1961 report_file_error ("Removing old name", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 internal_delete_file_1 (Lisp_Object ignore, Lisp_Object ignore2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 internal_delete_file (Lisp_Object filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 internal_delete_file_1, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 DEFUN ("rename-file", Frename_file, 2, 3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 "fRename file: \nFRename %s to file: \np", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1983 Rename FILENAME as NEWNAME. Both args must be strings.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1984 If file has names other than FILENAME, it continues to have those names.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 Signals a `file-already-exists' error if a file NEWNAME already exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 A number as third arg means request confirmation if NEWNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 This is what happens in interactive use with M-x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 (filename, newname, ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 GCPRO2 (filename, newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 CHECK_STRING (newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 newname = Fexpand_file_name (newname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 handler = Ffind_file_name_handler (filename, Qrename_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 handler = Ffind_file_name_handler (newname, Qrename_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 return call4 (handler, Qrename_file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 filename, newname, ok_if_already_exists);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 /* When second argument is a directory, rename the file into it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 if (!NILP (Ffile_directory_p (newname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 Lisp_Object args[3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 int i = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 args[0] = newname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 args[1] = Qnil; args[2] = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 NGCPRO1 (*args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 ngcpro1.nvars = 3;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2027 if (string_byte (newname, XSTRING_LENGTH (newname) - 1) != '/')
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 args[i++] = build_string ("/");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 args[i++] = Ffile_name_nondirectory (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 newname = Fconcat (i, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 barf_or_query_if_file_exists (newname, "rename to it",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 INTP (ok_if_already_exists), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2039 /* We have configure check for rename() and emulate using
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2040 link()/unlink() if necessary. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2041 if (0 > qxe_rename (XSTRING_DATA (filename), XSTRING_DATA (newname)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 if (errno == EXDEV)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 Fcopy_file (filename, newname,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 /* We have already prompted if it was an integer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 so don't have copy-file prompt again. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 (NILP (ok_if_already_exists) ? Qnil : Qt),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 Fdelete_file (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2054 report_file_error ("Renaming", list3 (Qunbound, filename, newname));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 "fAdd name to file: \nFName to add to %s: \np", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2063 Give FILENAME additional name NEWNAME. Both args must be strings.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 Signals a `file-already-exists' error if a file NEWNAME already exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 A number as third arg means request confirmation if NEWNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 This is what happens in interactive use with M-x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 (filename, newname, ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 /* This function can GC. GC checked 1997.04.06. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 GCPRO2 (filename, newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 CHECK_STRING (newname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 newname = Fexpand_file_name (newname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 newname, ok_if_already_exists));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 /* If the new name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 newname, ok_if_already_exists));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 barf_or_query_if_file_exists (newname, "make it a new name",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 INTP (ok_if_already_exists), 0);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2099 /* #### Emacs 20.6 contains an implementation of link() in w32.c.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2100 Need to port. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2101 #ifndef HAVE_LINK
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2102 signal_error_2 (Qunimplemented, "Adding new name", filename, newname);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2103 #else /* HAVE_LINK */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2104 qxe_unlink (XSTRING_DATA (newname));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2105 if (0 > qxe_link (XSTRING_DATA (filename), XSTRING_DATA (newname)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 report_file_error ("Adding new name",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2108 list3 (Qunbound, filename, newname));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2110 #endif /* HAVE_LINK */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 Signals a `file-already-exists' error if a file LINKNAME already exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 A number as third arg means request confirmation if LINKNAME already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 This happens for interactive use with M-x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 (filename, linkname, ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 /* This function can GC. GC checked 1997.06.04. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2127 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 GCPRO2 (filename, linkname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 CHECK_STRING (linkname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 /* If the link target has a ~, we must expand it to get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 a truly valid file name. Otherwise, do not expand;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 we want to permit links to relative file names. */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2137 if (string_byte (filename, 0) == '~')
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 linkname = Fexpand_file_name (linkname, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 ok_if_already_exists));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 /* If the new link name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 linkname, ok_if_already_exists));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2155 #ifdef HAVE_SYMLINK
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 if (NILP (ok_if_already_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 || INTP (ok_if_already_exists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 barf_or_query_if_file_exists (linkname, "make it a link",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 INTP (ok_if_already_exists), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2161 qxe_unlink (XSTRING_DATA (linkname));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2162 if (0 > qxe_symlink (XSTRING_DATA (filename),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2163 XSTRING_DATA (linkname)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 report_file_error ("Making symbolic link",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2166 list3 (Qunbound, filename, linkname));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2168 #endif
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2169
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 #ifdef HPUX_NET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 Open a network connection to PATH using LOGIN as the login string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 (path, login))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 int netresult;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2182 const char *path_ext;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2183 const char *login_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 CHECK_STRING (path);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 CHECK_STRING (login);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 /* netunam, being a strange-o system call only used once, is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 encapsulated. */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2190
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2191 LISP_STRING_TO_EXTERNAL (path, path_ext, Qfile_name);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2192 LISP_STRING_TO_EXTERNAL (login, login_ext, Qnative);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2193
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2194 netresult = netunam (path_ext, login_ext);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2195
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
2196 return netresult == -1 ? Qnil : Qt;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 #endif /* HPUX_NET */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 Return t if file FILENAME specifies an absolute path name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 On Unix, this is a name starting with a `/' or a `~'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 /* This function does not GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2207 Intbyte *ptr;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 ptr = XSTRING_DATA (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
2212 #ifdef WIN32_FILENAMES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 ) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 /* Return nonzero if file FILENAME exists and can be executed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 static int
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2221 check_executable (Lisp_Object filename)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2223 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 struct stat st;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2225 if (qxe_stat (XSTRING_DATA (filename), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 return ((st.st_mode & S_IEXEC) != 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2228 #else /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 #ifdef HAVE_EACCESS
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2230 return qxe_eaccess (XSTRING_DATA (filename), X_OK) >= 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 /* Access isn't quite right because it uses the real uid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 and we really want to test with the effective uid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 But Unix doesn't give us a right way to do it. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2235 return qxe_access (XSTRING_DATA (filename), X_OK) >= 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 #endif /* HAVE_EACCESS */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2237 #endif /* not WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 /* Return nonzero if file FILENAME exists and can be written. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 static int
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2243 check_writable (const Intbyte *filename)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 #ifdef HAVE_EACCESS
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2246 return (qxe_eaccess (filename, W_OK) >= 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 /* Access isn't quite right because it uses the real uid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 and we really want to test with the effective uid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 But Unix doesn't give us a right way to do it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 Opening with O_WRONLY could work for an ordinary file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 but would lose for directories. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2253 return (qxe_access (filename, W_OK) >= 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258 Return t if file FILENAME exists. (This does not mean you can read it.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 See also `file-readable-p' and `file-attributes'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2263 /* This function can call lisp; GC checked 2000-07-11 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 struct stat statbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 abspath = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 return call2 (handler, Qfile_exists_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2280 return qxe_stat (XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 Return t if FILENAME can be executed by you.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285 For a directory, this means you can access files in that directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2290 /* This function can GC. GC checked 07-11-2000 ben. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 abspath = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 return call2 (handler, Qfile_executable_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2306 return check_executable (abspath) ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 Return t if file FILENAME exists and you can read it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311 See also `file-exists-p' and `file-attributes'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 Lisp_Object abspath = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 abspath = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
2330 #if defined(WIN32_FILENAMES)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 /* Under MS-DOS and Windows, open does not work for directories. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 UNGCPRO;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2333 if (qxe_access (XSTRING_DATA (abspath), 0) == 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 return Qnil;
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
2337 #else /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2339 int desc = qxe_interruptible_open (XSTRING_DATA (abspath),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2340 O_RDONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 if (desc < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 return Qnil;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2344 retry_close (desc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 }
657
ce0b3f2eff35 [xemacs-hg @ 2001-09-09 04:37:41 by andyp]
andyp
parents: 647
diff changeset
2347 #endif /* not WIN32_FILENAMES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 on the RT/PC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 Return t if file FILENAME can be written or created by you.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 Lisp_Object abspath, dir;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 struct stat statbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 abspath = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 return call2 (handler, Qfile_writable_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2374 if (qxe_stat (XSTRING_DATA (abspath), &statbuf) >= 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2375 return (check_writable (XSTRING_DATA (abspath))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 ? Qt : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 dir = Ffile_name_directory (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 UNGCPRO;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2382 return (check_writable (!NILP (dir) ? XSTRING_DATA (dir) : (Intbyte *) "")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 ? Qt : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 Return non-nil if file FILENAME is the name of a symbolic link.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 The value is the name of the file to which it is linked.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 Otherwise returns nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 /* This function can GC. GC checked 1997.04.10. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2394 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2395 #ifdef HAVE_READLINK
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2396 Intbyte *buf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397 int bufsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 int valsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 Lisp_Object val;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2400 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 GCPRO1 (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 return call2 (handler, Qfile_symlink_p, filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2415 #ifdef HAVE_READLINK
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416 bufsize = 100;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2419 buf = xnew_array_and_zero (Intbyte, bufsize);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2420 valsize = qxe_readlink (XSTRING_DATA (filename),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2421 buf, bufsize);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 if (valsize < bufsize) break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423 /* Buffer was not long enough */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 xfree (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 bufsize *= 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427 if (valsize == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 xfree (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2432 val = make_string (buf, valsize);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 xfree (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434 return val;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2435 #else /* not HAVE_READLINK */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436 return Qnil;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2437 #endif /* not HAVE_READLINK */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 Return t if file FILENAME is the name of a directory as a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442 A directory name spec may be given instead; then the value is t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 if the directory so specified exists and really is a directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 abspath = expand_and_dir_to_file (filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455 current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 return call2 (handler, Qfile_directory_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2466 if (qxe_stat (XSTRING_DATA (abspath), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 Return t if file FILENAME is the name of a directory as a file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 and files in that directory can be opened by you. In order to use a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 directory as a buffer's current directory, this predicate must return true.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 A directory name spec may be given instead; then the value is t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 if the directory so specified exists and really is a readable and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 searchable directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 return call2 (handler, Qfile_accessible_directory_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2491 #if !defined(WIN32_NATIVE)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 if (NILP (Ffile_directory_p (filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 return (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 return Ffile_executable_p (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 int tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 /* It's an unlikely combination, but yes we really do need to gcpro:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 Suppose that file-accessible-directory-p has no handler, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 file-directory-p does have a handler; this handler causes a GC which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 relocates the string in `filename'; and finally file-directory-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 returns non-nil. Then we would end up passing a garbaged string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505 to file-executable-p. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 GCPRO1 (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507 tem = (NILP (Ffile_directory_p (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 || NILP (Ffile_executable_p (filename)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 return tem ? Qnil : Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2512 #endif /* !defined(WIN32_NATIVE) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 Return t if file FILENAME is the name of a regular file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 This is the sort of file that holds an ordinary stream of data bytes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 return call2 (handler, Qfile_regular_p, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2539 if (qxe_stat (XSTRING_DATA (abspath), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2540 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2545 Return mode bits of file named FILENAME, as an integer.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 abspath = expand_and_dir_to_file (filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557 current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2561 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2562 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 handler = Ffind_file_name_handler (abspath, Qfile_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2566 return call2 (handler, Qfile_modes, abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2567
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2568 if (qxe_stat (XSTRING_DATA (abspath), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2571 #if 0
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2572 #ifdef WIN32_NATIVE
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2573 if (check_executable (abspath))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2574 st.st_mode |= S_IEXEC;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2575 #endif /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2576 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578 return make_int (st.st_mode & 07777);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2581 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2582 Set mode bits of file named FILENAME to MODE (an integer).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 Only the 12 low bits of MODE are used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 (filename, mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2588 Lisp_Object abspath;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2590 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2592 GCPRO1 (current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2593 abspath = Fexpand_file_name (filename, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2594 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2595
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2596 CHECK_INT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2597
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2598 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2599 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2600 GCPRO1 (abspath);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2601 handler = Ffind_file_name_handler (abspath, Qset_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2602 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2603 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2604 return call3 (handler, Qset_file_modes, abspath, mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2605
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2606 if (qxe_chmod (XSTRING_DATA (abspath), XINT (mode)) < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2607 report_file_error ("Doing chmod", abspath);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2608
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2609 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2610 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2611
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2612 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2613 Set the file permission bits for newly created files.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2614 The argument MODE should be an integer; if a bit in MODE is 1,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2615 subsequently created files will not have the permission corresponding
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2616 to that bit enabled. Only the low 9 bits are used.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2617 This setting is inherited by subprocesses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2618 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2619 (mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2620 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2621 CHECK_INT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2623 umask ((~ XINT (mode)) & 0777);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2624
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2625 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2626 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2628 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2629 Return the default file protection for created files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2630 The umask value determines which permissions are enabled in newly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2631 created files. If a permission's bit in the umask is 1, subsequently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2632 created files will not have that permission enabled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2633 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2634 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2635 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2636 int mode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2638 mode = umask (0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2639 umask (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2641 return make_int ((~ mode) & 0777);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2642 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2643
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2644 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2645 Tell Unix to finish all pending disk updates.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2646 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2647 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2649 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2650 sync ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2654
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2657 Return t if file FILE1 is newer than file FILE2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658 If FILE1 does not exist, the answer is nil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 otherwise, if FILE2 does not exist, the answer is t.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661 (file1, file2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2662 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2663 /* This function can GC. GC checked 1997.04.10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664 Lisp_Object abspath1, abspath2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 int mtime1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2667 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 CHECK_STRING (file1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 CHECK_STRING (file2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 abspath1 = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 abspath2 = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676 GCPRO3 (abspath1, abspath2, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2679
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2687 return call3 (handler, Qfile_newer_than_file_p, abspath1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2688 abspath2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2689
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2690 if (qxe_stat (XSTRING_DATA (abspath1), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2691 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693 mtime1 = st.st_mtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2695 if (qxe_stat (XSTRING_DATA (abspath2), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2696 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698 return (mtime1 > st.st_mtime) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2702 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2703 /* #define READ_BUF_SIZE (2 << 16) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704 #define READ_BUF_SIZE (1 << 15)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707 1, 7, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 Insert contents of file FILENAME after point; no coding-system frobbing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709 This function is identical to `insert-file-contents' except for the
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2710 handling of the CODESYS and USED-CODESYS arguments.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2711
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2712 The file is decoded according to CODESYS; if omitted, no conversion
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2713 happens. If USED-CODESYS is non-nil, it should be a symbol, and the actual
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2714 coding system that was used for the decoding is stored into it. It will in
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2715 general be different from CODESYS if CODESYS specifies automatic encoding
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2716 detection or end-of-line detection.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2717
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2718 Currently START and END refer to byte positions (as opposed to character
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2719 positions), even in Mule and under MS Windows. (Fixing this, particularly
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2720 under Mule, is very difficult.)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2721 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2722 (filename, visit, start, end, replace, codesys, used_codesys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2723 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2724 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2725 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2726 int fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2727 int saverrno = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2728 Charcount inserted = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2729 int speccount;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731 Lisp_Object handler = Qnil, val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 int total;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2733 Intbyte read_buf[READ_BUF_SIZE];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2734 int mc_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 struct buffer *buf = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736 Lisp_Object curbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2737 int not_regular = 0;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2738 int do_speedy_insert =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2739 coding_system_is_binary (Fget_coding_system (codesys));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2740
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741 if (buf->base_buffer && ! NILP (visit))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2742 invalid_operation ("Cannot do file visiting in an indirect buffer", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2743
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2744 /* No need to call Fbarf_if_buffer_read_only() here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2745 That's called in begin_multiple_change() or wherever. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2746
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2747 val = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2749 /* #### dmoore - should probably check in various places to see if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2750 curbuf was killed and if so signal an error? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
2752 curbuf = wrap_buffer (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2753
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2754 GCPRO5 (filename, val, visit, handler, curbuf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2756 mc_count = (NILP (replace)) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2758 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2759
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2760 speccount = specpdl_depth (); /* begin_multiple_change also adds
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2761 an unwind_protect */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2762
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2763 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2765 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2767 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2768 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2769 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2770 val = call6 (handler, Qinsert_file_contents, filename,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2771 visit, start, end, replace);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2772 goto handled;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2774
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2775 if (!NILP (used_codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 CHECK_SYMBOL (used_codesys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2778 if ( (!NILP (start) || !NILP (end)) && !NILP (visit) )
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2779 invalid_operation ("Attempt to visit less than an entire file", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2780
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2781 fd = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2783 if (qxe_stat (XSTRING_DATA (filename), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2785 if (fd >= 0) retry_close (fd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2786 badopen:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787 if (NILP (visit))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2788 report_file_error ("Opening input file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2789 st.st_mtime = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790 goto notfound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793 #ifdef S_IFREG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2794 /* Signal an error if we are accessing a non-regular file, with
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2795 REPLACE, START or END being non-nil. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796 if (!S_ISREG (st.st_mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 not_regular = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800 if (!NILP (visit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 goto notfound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2802
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2803 if (!NILP (replace) || !NILP (start) || !NILP (end))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2804 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 end_multiple_change (buf, mc_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2806
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2807 RETURN_UNGCPRO
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2808 (Fsignal (Qfile_error,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2809 list2 (build_msg_string("not a regular file"),
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2810 filename)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2812 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2813 #endif /* S_IFREG */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2815 if (!NILP (start))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2816 CHECK_INT (start);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2817 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2818 start = Qzero;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2820 if (!NILP (end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 CHECK_INT (end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823 if (fd < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2825 if ((fd = qxe_interruptible_open (XSTRING_DATA (filename),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2826 O_RDONLY | OPEN_BINARY, 0)) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2827 goto badopen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830 /* Replacement should preserve point as it preserves markers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2831 if (!NILP (replace))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2832 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2833
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834 record_unwind_protect (close_file_unwind, make_int (fd));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836 /* Supposedly happens on VMS. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 if (st.st_size < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2838 signal_error (Qfile_error, "File size is negative", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2840 if (NILP (end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2841 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842 if (!not_regular)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2844 end = make_int (st.st_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2845 if (XINT (end) != st.st_size)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2846 out_of_memory ("Maximum buffer size exceeded", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2847 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2848 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2849
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2850 /* If requested, replace the accessible part of the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2851 with the file contents. Avoid replacing text at the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2852 beginning or end of the buffer that matches the file contents;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2853 that preserves markers pointing to the unchanged parts. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2854 /* The replace-mode code is currently implemented by comparing the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2855 file on disk with the contents in the buffer, character by character.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2856 That works only if the characters on disk are exactly what will go into
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2857 the buffer -- i.e. `binary' conversion.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2858
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2859 FSF tries to implement this in all situations, even the non-binary
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2860 conversion, by (in that case) loading the whole converted file into a
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2861 separate memory area, then doing the comparison. I really don't see
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2862 the point of this, and it will fail spectacularly if the file is many
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2863 megabytes in size. To try to get around this, we could certainly read
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2864 from the beginning and decode as necessary before comparing, but doing
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2865 the same at the end gets very difficult because of the possibility of
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2866 modal coding systems -- trying to decode data from any point forward
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2867 without decoding previous data might always give you different results
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2868 from starting at the beginning. We could try further tricks like
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2869 keeping track of which coding systems are non-modal and providing some
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2870 extra method for such coding systems to be given a chunk of data that
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2871 came from a specified location in a specified file and ask the coding
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2872 systems to return a "sync point" from which the data can be read
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2873 forward and have results guaranteed to be the same as reading from the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2874 beginning to that point, but I really don't think it's worth it. If
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2875 we implemented the FSF "brute-force" method, we would have to put a
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2876 reasonable maximum file size on the files. Is any of this worth it?
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2877 --ben
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2878
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2879 */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2880
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2881 if (!NILP (replace))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2882 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2883 if (!do_speedy_insert)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2884 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2885 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2886 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2887 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2888 char buffer[1 << 14];
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2889 Charbpos same_at_start = BUF_BEGV (buf);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2890 Charbpos same_at_end = BUF_ZV (buf);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2891 int overlap;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2892
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2893 /* Count how many chars at the start of the file
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2894 match the text at the beginning of the buffer. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2895 while (1)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2896 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2897 int nread;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2898 Charbpos charbpos;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2899 nread = read_allowing_quit (fd, buffer, sizeof (buffer));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2900 if (nread < 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2901 report_file_error ("Reading", filename);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2902 else if (nread == 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2903 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2904 charbpos = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2905 while (charbpos < nread && same_at_start < BUF_ZV (buf)
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2906 && BUF_FETCH_CHAR (buf, same_at_start) ==
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2907 buffer[charbpos])
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2908 same_at_start++, charbpos++;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2909 /* If we found a discrepancy, stop the scan.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2910 Otherwise loop around and scan the next bufferful. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2911 if (charbpos != nread)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2912 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2913 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2914 /* If the file matches the buffer completely,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2915 there's no need to replace anything. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2916 if (same_at_start - BUF_BEGV (buf) == st.st_size)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2917 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2918 retry_close (fd);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2919 unbind_to (speccount);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2920 /* Truncate the buffer to the size of the file. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2921 buffer_delete_range (buf, same_at_start, same_at_end,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2922 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2923 goto handled;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2924 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2925 /* Count how many chars at the end of the file
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2926 match the text at the end of the buffer. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2927 while (1)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2928 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2929 int total_read, nread;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2930 Charcount charbpos, curpos, trial;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2931
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2932 /* At what file position are we now scanning? */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2933 curpos = st.st_size - (BUF_ZV (buf) - same_at_end);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2934 /* If the entire file matches the buffer tail, stop the scan. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2935 if (curpos == 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2936 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2937 /* How much can we scan in the next step? */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2938 trial = min (curpos, (Charbpos) sizeof (buffer));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2939 if (lseek (fd, curpos - trial, 0) < 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2940 report_file_error ("Setting file position", filename);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2941
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2942 total_read = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2943 while (total_read < trial)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2944 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2945 nread = read_allowing_quit (fd, buffer + total_read,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2946 trial - total_read);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2947 if (nread <= 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2948 report_file_error ("IO error reading file", filename);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2949 total_read += nread;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2950 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2951 /* Scan this bufferful from the end, comparing with
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2952 the Emacs buffer. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2953 charbpos = total_read;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2954 /* Compare with same_at_start to avoid counting some buffer text
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2955 as matching both at the file's beginning and at the end. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2956 while (charbpos > 0 && same_at_end > same_at_start
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2957 && BUF_FETCH_CHAR (buf, same_at_end - 1) ==
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2958 buffer[charbpos - 1])
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2959 same_at_end--, charbpos--;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2960 /* If we found a discrepancy, stop the scan.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2961 Otherwise loop around and scan the preceding bufferful. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2962 if (charbpos != 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2963 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2964 /* If display current starts at beginning of line,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2965 keep it that way. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2966 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2967 XWINDOW (Fselected_window (Qnil))->start_at_line_beg =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2968 !NILP (Fbolp (wrap_buffer (buf)));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2969 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2970
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2971 /* Don't try to reuse the same piece of text twice. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2972 overlap = same_at_start - BUF_BEGV (buf) -
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2973 (same_at_end + st.st_size - BUF_ZV (buf));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2974 if (overlap > 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2975 same_at_end += overlap;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2976
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2977 /* Arrange to read only the nonmatching middle part of the file. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2978 start = make_int (same_at_start - BUF_BEGV (buf));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2979 end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2980
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2981 buffer_delete_range (buf, same_at_start, same_at_end,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2982 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2983 /* Insert from the file at the proper position. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
2984 BUF_SET_PT (buf, same_at_start);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2985 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2988 if (!not_regular)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2990 total = XINT (end) - XINT (start);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2992 /* Make sure point-max won't overflow after this insertion. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993 if (total != XINT (make_int (total)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2994 out_of_memory ("Maximum buffer size exceeded", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2995 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2996 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997 /* For a special file, all we can do is guess. The value of -1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 will make the stream functions read as much as possible. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2999 total = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3000
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3001 if (XINT (start) != 0
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3002 /* why was this here? asked jwz. The reason is that the replace-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3003 connivings above will normally put the file pointer other than
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004 where it should be. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3005 || (!NILP (replace) && do_speedy_insert))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3006 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3007 if (lseek (fd, XINT (start), 0) < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3008 report_file_error ("Setting file position", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3009 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
3012 Charbpos cur_point = BUF_PT (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015 LSTR_ALLOW_QUIT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 NGCPRO1 (stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3018 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3019 stream = make_coding_input_stream
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3020 (XLSTREAM (stream), get_coding_system_for_text_file (codesys, 1),
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
3021 CODING_DECODE, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3022 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3023
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024 record_unwind_protect (delete_stream_unwind, stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3026 /* No need to limit the amount of stuff we attempt to read. (It would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3027 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 occurs inside of the filedesc stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
3031 Bytecount this_len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3032 Charcount cc_inserted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3035 this_len = Lstream_read (XLSTREAM (stream), read_buf,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3036 sizeof (read_buf));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3037
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038 if (this_len <= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3039 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3040 if (this_len < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3041 saverrno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3042 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3043 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3044
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3045 cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3046 this_len,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047 !NILP (visit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048 ? INSDEL_NO_LOCKING : 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049 inserted += cc_inserted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050 cur_point += cc_inserted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3051 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3052 if (!NILP (used_codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3054 Fset (used_codesys,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3055 XCODING_SYSTEM_NAME
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3056 (coding_stream_detected_coding_system (XLSTREAM (stream))));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3058 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3059 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061 /* Close the file/stream */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3062 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3063
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064 if (saverrno != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3066 errno = saverrno;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3067 report_file_error ("Reading", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3068 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3069
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3070 notfound:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3071 handled:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3073 end_multiple_change (buf, mc_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3074
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3075 if (!NILP (visit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3076 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3077 if (!EQ (buf->undo_list, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3078 buf->undo_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3079 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3081 buf->modtime = st.st_mtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 buf->filename = filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 /* XEmacs addition: */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3084 /* This function used to be in C, ostensibly so that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085 it could be called here. But that's just silly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086 There's no reason C code can't call out to Lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087 code, and it's a lot cleaner this way. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3088 /* Note: compute-buffer-file-truename is called for
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3089 side-effect! Its return value is intentionally
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3090 ignored. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091 if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3092 call1 (Qcompute_buffer_file_truename, wrap_buffer (buf));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3093 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3094 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3095 buf->auto_save_modified = BUF_MODIFF (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 buf->saved_size = make_int (BUF_SIZE (buf));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098 if (NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3099 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 if (!NILP (buf->file_truename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3101 unlock_file (buf->file_truename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102 unlock_file (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3103 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3104 #endif /* CLASH_DETECTION */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3105 if (not_regular)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3106 RETURN_UNGCPRO (Fsignal (Qfile_error,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3107 list2 (build_msg_string ("not a regular file"),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3108 filename)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3110 /* If visiting nonexistent file, return nil. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3111 if (buf->modtime == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3112 report_file_error ("Opening input file",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3113 filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3114 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3116 /* Decode file format */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3117 if (inserted > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3118 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3119 Lisp_Object insval = call3 (Qformat_decode,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3120 Qnil, make_int (inserted), visit);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3121 CHECK_INT (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3122 inserted = XINT (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3123 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3125 if (inserted > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3126 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3127 Lisp_Object p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3128 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3130 NGCPRO1 (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3131 EXTERNAL_LIST_LOOP (p, Vafter_insert_file_functions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3132 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3133 Lisp_Object insval =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3134 call1 (XCAR (p), make_int (inserted));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3135 if (!NILP (insval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3136 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3137 CHECK_NATNUM (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3138 inserted = XINT (insval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3139 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3140 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3141 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3142 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3143 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3145 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3147 if (!NILP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3148 return (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3149 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3150 return (list2 (filename, make_int (inserted)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3151 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3154 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3155 Lisp_Object *annot);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3156 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3158 /* If build_annotations switched buffers, switch back to BUF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3159 Kill the temporary buffer that was selected in the meantime. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3161 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 build_annotations_unwind (Lisp_Object buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 Lisp_Object tembuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166 if (XBUFFER (buf) == current_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3168 tembuf = Fcurrent_buffer ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3169 Fset_buffer (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3170 Fkill_buffer (tembuf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175 "r\nFWrite region to file: ", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 Write current region into specified file; no coding-system frobbing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 This function is identical to `write-region' except for the handling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178 of the CODESYS argument under XEmacs/Mule. (When Mule support is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179 present, both functions are identical and ignore the CODESYS argument.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180 If support for Mule exists in this Emacs, the file is encoded according
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3181 to the value of CODESYS. If this is nil, no code conversion occurs.
764
3c5d0bca9200 [xemacs-hg @ 2002-03-05 13:00:37 by stephent]
stephent
parents: 751
diff changeset
3182
3c5d0bca9200 [xemacs-hg @ 2002-03-05 13:00:37 by stephent]
stephent
parents: 751
diff changeset
3183 As a special kludge to support auto-saving, when START is nil START and
3c5d0bca9200 [xemacs-hg @ 2002-03-05 13:00:37 by stephent]
stephent
parents: 751
diff changeset
3184 END are set to the beginning and end, respectively, of the buffer,
3c5d0bca9200 [xemacs-hg @ 2002-03-05 13:00:37 by stephent]
stephent
parents: 751
diff changeset
3185 regardless of any restrictions. Don't use this feature. It is documented
3c5d0bca9200 [xemacs-hg @ 2002-03-05 13:00:37 by stephent]
stephent
parents: 751
diff changeset
3186 here because write-region handler writers need to be aware of it.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3187 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188 (start, end, filename, append, visit, lockname, codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3190 /* This function can call lisp. GC checked 2000-07-28 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3191 int desc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192 int failure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3193 int save_errno = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194 struct stat st;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3195 Lisp_Object fn = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3196 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 int visiting_other = STRINGP (visit);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198 int visiting = (EQ (visit, Qt) || visiting_other);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199 int quietly = (!visiting && !NILP (visit));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200 Lisp_Object visit_file = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3201 Lisp_Object annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3202 struct buffer *given_buffer;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
3203 Charbpos start1, end1;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3204 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3205 struct gcpro ngcpro1, ngcpro2;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3206 Lisp_Object curbuf = wrap_buffer (current_buffer);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3207
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3208
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3209 /* start, end, visit, and append are never modified in this fun
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3210 so we don't protect them. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3211 GCPRO5 (visit_file, filename, codesys, lockname, annotations);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3212 NGCPRO2 (curbuf, fn);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3213
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3214 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215 we should signal an error rather than blissfully continuing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 along. ARGH, this function is going to lose lose lose. We need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 to protect the current_buffer from being destroyed, but the
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3218 multiple return points make this a pain in the butt. ]] we do
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3219 protect curbuf now. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3220
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3221 codesys = get_coding_system_for_text_file (codesys, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223 if (current_buffer->base_buffer && ! NILP (visit))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3224 invalid_operation ("Cannot do file visiting in an indirect buffer",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3225 curbuf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 if (!NILP (start) && !STRINGP (start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233 if (visiting_other)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 visit_file = Fexpand_file_name (visit, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3235 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236 visit_file = filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3239 if (NILP (lockname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 lockname = visit_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3242 /* We used to UNGCPRO here. BAD! visit_file is used below after
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3243 more Lisp calling. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3244 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246 handler = Ffind_file_name_handler (filename, Qwrite_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247 /* If FILENAME has no handler, see if VISIT has one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 if (NILP (handler) && STRINGP (visit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 handler = Ffind_file_name_handler (visit, Qwrite_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253 Lisp_Object val = call8 (handler, Qwrite_region, start, end,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3254 filename, append, visit, lockname, codesys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3255 if (visiting)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3256 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3257 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3258 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3259 current_buffer->filename = visit_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 MARK_MODELINE_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3261 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3262 NUNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3263 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3264 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3265 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3266 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3268 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3269 if (!auto_saving)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3270 lock_file (lockname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3271 #endif /* CLASH_DETECTION */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3273 /* Special kludge to simplify auto-saving. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3274 if (NILP (start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3276 start1 = BUF_BEG (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3277 end1 = BUF_Z (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3278 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3280 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3281
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3282 given_buffer = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3283 annotations = build_annotations (start, end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3284 if (current_buffer != given_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3285 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3286 start1 = BUF_BEGV (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3287 end1 = BUF_ZV (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3288 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3290 fn = filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3291 desc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3292 if (!NILP (append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3293 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3294 desc = qxe_open (XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3295 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3296 if (desc < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3297 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3298 desc = qxe_open (XSTRING_DATA (fn),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3299 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3300 auto_saving ? auto_save_mode_bits : CREAT_MODE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3301 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3303 if (desc < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3304 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3305 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3306 save_errno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3307 if (!auto_saving) unlock_file (lockname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3308 errno = save_errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3309 #endif /* CLASH_DETECTION */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3310 report_file_error ("Opening output file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3311 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3313 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3314 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3315 Lisp_Object instream = Qnil, outstream = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3316 struct gcpro nngcpro1, nngcpro2;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3317 /* need to gcpro; QUIT could happen out of call to retry_write() */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3318 NNGCPRO2 (instream, outstream);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3320 record_unwind_protect (close_file_unwind, desc_locative);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3322 if (!NILP (append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3323 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3324 if (lseek (desc, 0, 2) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3325 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3326 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3327 if (!auto_saving) unlock_file (lockname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3328 #endif /* CLASH_DETECTION */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3329 report_file_error ("Lseek error",
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3330 filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3331 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3332 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3334 failure = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3335
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3336 /* Note: I tried increasing the buffering size, along with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3337 various other tricks, but nothing seemed to make much of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3338 a difference in the time it took to save a large file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3339 (Actually that's not true. With a local disk, changing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3340 the buffer size doesn't seem to make much difference.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3341 With an NFS-mounted disk, it could make a lot of difference
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3342 because you're affecting the number of network requests
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3343 that need to be made, and there could be a large latency
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3344 for each request. So I've increased the buffer size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3345 to 64K.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3346 outstream = make_filedesc_output_stream (desc, 0, -1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3347 Lstream_set_buffering (XLSTREAM (outstream),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3348 LSTREAM_BLOCKN_BUFFERED, 65536);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3349 outstream =
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
3350 make_coding_output_stream (XLSTREAM (outstream), codesys,
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
3351 CODING_ENCODE, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3352 Lstream_set_buffering (XLSTREAM (outstream),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3353 LSTREAM_BLOCKN_BUFFERED, 65536);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3354 if (STRINGP (start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3355 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3356 instream = make_lisp_string_input_stream (start, 0, -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3357 start1 = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3358 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3359 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3360 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3361 LSTR_SELECTIVE |
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3362 LSTR_IGNORE_ACCESSIBLE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3363 failure = (0 > (a_write (outstream, instream, start1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3364 &annotations)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3365 save_errno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3366 /* Note that this doesn't close the desc since we created the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3367 stream without the LSTR_CLOSING flag, but it does
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3368 flush out any buffered data. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3369 if (Lstream_close (XLSTREAM (outstream)) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3370 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3371 failure = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3372 save_errno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3373 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3374 Lstream_close (XLSTREAM (instream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3376 #ifdef HAVE_FSYNC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3377 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3378 Disk full in NFS may be reported here. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3379 /* mib says that closing the file will try to write as fast as NFS can do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3380 it, and that means the fsync here is not crucial for autosave files. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3381 if (!auto_saving && fsync (desc) < 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3382 /* If fsync fails with EINTR, don't treat that as serious. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3383 && errno != EINTR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3384 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3385 failure = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3386 save_errno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3387 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3388 #endif /* HAVE_FSYNC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3389
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
3390 /* Spurious "file has changed on disk" warnings used to be seen on
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
3391 systems where close() can change the modtime. This is known to
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
3392 happen on various NFS file systems, on Windows, and on Linux.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
3393 Rather than handling this on a per-system basis, we
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3394 unconditionally do the qxe_stat() after the retry_close(). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3396 /* NFS can report a write failure now. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3397 if (retry_close (desc) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3398 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3399 failure = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3400 save_errno = errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3401 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3402
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3403 /* Discard the close unwind-protect. Execute the one for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3404 build_annotations (switches back to the original current buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3405 as necessary). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3406 XCAR (desc_locative) = Qnil;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3407 unbind_to (speccount);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3408
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3409 NNUNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3410 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3411
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3412 qxe_stat (XSTRING_DATA (fn), &st);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3414 #ifdef CLASH_DETECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3415 if (!auto_saving)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3416 unlock_file (lockname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3417 #endif /* CLASH_DETECTION */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3418
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3419 /* Do this before reporting IO error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3420 to avoid a "file has changed on disk" warning on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3421 next attempt to save. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3422 if (visiting)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3423 current_buffer->modtime = st.st_mtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3424
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3425 if (failure)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3426 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3427 errno = save_errno;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3428 report_file_error ("Writing file", fn);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3429 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3431 if (visiting)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3432 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3433 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3434 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3435 current_buffer->filename = visit_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3436 MARK_MODELINE_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3437 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3438 else if (quietly)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3439 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3440 NUNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3441 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3442 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3443 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3445 if (!auto_saving)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3446 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3447 if (visiting_other)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3448 message ("Wrote %s", XSTRING_DATA (visit_file));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3449 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3450 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3451 Lisp_Object fsp = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3452 struct gcpro nngcpro1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3453
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3454 NNGCPRO1 (fsp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3455 fsp = Ffile_symlink_p (fn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3456 if (NILP (fsp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3457 message ("Wrote %s", XSTRING_DATA (fn));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3458 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3459 message ("Wrote %s (symlink to %s)",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3460 XSTRING_DATA (fn), XSTRING_DATA (fsp));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3461 NNUNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3462 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3463 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3464 NUNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3465 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3466 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3467 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3469 /* #### This is such a load of shit!!!! There is no way we should define
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3470 something so stupid as a subr, just sort the fucking list more
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3471 intelligently. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3472 DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3473 Return t if (car A) is numerically less than (car B).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3474 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3475 (a, b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3476 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3477 Lisp_Object objs[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3478 objs[0] = Fcar (a);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3479 objs[1] = Fcar (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3480 return Flss (2, objs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3481 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3482
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3483 /* Heh heh heh, let's define this too, just to aggravate the person who
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3484 wrote the above comment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3485 DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3486 Return t if (cdr A) is numerically less than (cdr B).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3487 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3488 (a, b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3489 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3490 Lisp_Object objs[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3491 objs[0] = Fcdr (a);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3492 objs[1] = Fcdr (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3493 return Flss (2, objs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3494 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3495
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3496 /* Build the complete list of annotations appropriate for writing out
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3497 the text between START and END, by calling all the functions in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3498 write-region-annotate-functions and merging the lists they return.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3499 If one of these functions switches to a different buffer, we assume
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3500 that buffer contains altered text. Therefore, the caller must
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3501 make sure to restore the current buffer in all cases,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3502 as save-excursion would do. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3503
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3504 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3505 build_annotations (Lisp_Object start, Lisp_Object end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3506 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3507 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3508 Lisp_Object annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3509 Lisp_Object p, res;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3510 struct gcpro gcpro1, gcpro2;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3511 Lisp_Object original_buffer = wrap_buffer (current_buffer);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3512
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3513
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3514 annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3515 p = Vwrite_region_annotate_functions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3516 GCPRO2 (annotations, p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3517 while (!NILP (p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3518 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3519 struct buffer *given_buffer = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3520 Vwrite_region_annotations_so_far = annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3521 res = call2 (Fcar (p), start, end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3522 /* If the function makes a different buffer current,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3523 assume that means this buffer contains altered text to be output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3524 Reset START and END from the buffer bounds
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3525 and discard all previous annotations because they should have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3526 been dealt with by this function. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3527 if (current_buffer != given_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3528 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3529 start = make_int (BUF_BEGV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3530 end = make_int (BUF_ZV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3531 annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3532 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3533 Flength (res); /* Check basic validity of return value */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3534 annotations = merge (annotations, res, Qcar_less_than_car);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3535 p = Fcdr (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3536 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3537
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3538 /* Now do the same for annotation functions implied by the file-format */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3539 if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3540 p = Vauto_save_file_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3541 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3542 p = current_buffer->file_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3543 while (!NILP (p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3544 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3545 struct buffer *given_buffer = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3546 Vwrite_region_annotations_so_far = annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3547 res = call4 (Qformat_annotate_function, Fcar (p), start, end,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3548 original_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3549 if (current_buffer != given_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3550 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3551 start = make_int (BUF_BEGV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3552 end = make_int (BUF_ZV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3553 annotations = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3554 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3555 Flength (res);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3556 annotations = merge (annotations, res, Qcar_less_than_car);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3557 p = Fcdr (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3558 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3559 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3560 return annotations;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3561 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3562
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3563 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3564 EOF is encountered), assuming they start at position POS in the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3565 of string that STREAM refers to. Intersperse with them the annotations
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3566 from *ANNOT that fall into the range of positions we are reading from,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3567 each at its appropriate position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3568
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3569 Modify *ANNOT by discarding elements as we output them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3570 The return value is negative in case of system call failure. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3571
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3572 /* 4K should probably be fine. We just need to reduce the number of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3573 function calls to reasonable level. The Lstream stuff itself will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3574 batch to 64K to reduce the number of system calls. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3575
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3576 #define A_WRITE_BATCH_SIZE 4096
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3578 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3579 a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3580 Lisp_Object *annot)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3581 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3582 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3583 int nextpos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3584 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3585 Lstream *instr = XLSTREAM (instream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3586 Lstream *outstr = XLSTREAM (outstream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3588 while (LISTP (*annot))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3589 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3590 tem = Fcar_safe (Fcar (*annot));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3591 if (INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3592 nextpos = XINT (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3593 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3594 nextpos = INT_MAX;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3595 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3596 /* If there are annotations left and we have Mule, then we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3597 have to do the I/O one emchar at a time so we can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3598 determine when to insert the annotation. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3599 if (!NILP (*annot))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3600 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3601 Emchar ch;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3602 while (pos != nextpos && (ch = Lstream_get_emchar (instr)) != EOF)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3603 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3604 if (Lstream_put_emchar (outstr, ch) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3605 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3606 pos++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3607 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3608 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3609 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3610 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3611 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3612 while (pos != nextpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3613 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3614 /* Otherwise there is no point to that. Just go in batches. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3615 int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3616
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3617 chunk = Lstream_read (instr, largebuf, chunk);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3618 if (chunk < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3619 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3620 if (chunk == 0) /* EOF */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3621 break;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3622 if (Lstream_write (outstr, largebuf, chunk) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3623 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3624 pos += chunk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3625 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3626 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3627 if (pos == nextpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3628 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3629 tem = Fcdr (Fcar (*annot));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3630 if (STRINGP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3631 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3632 if (Lstream_write (outstr, XSTRING_DATA (tem),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3633 XSTRING_LENGTH (tem)) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3634 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3635 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3636 *annot = Fcdr (*annot);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3637 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3638 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3639 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3640 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3641 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3642 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3643
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3645
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3646 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3647 #include <des_crypt.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3648
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3649 #define CRYPT_BLOCK_SIZE 8 /* bytes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3650 #define CRYPT_KEY_SIZE 8 /* bytes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3651
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3652 DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3653 Encrypt STRING using KEY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3654 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3655 (string, key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3656 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3657 char *encrypted_string, *raw_key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3658 int rounded_size, extra, key_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3659
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3660 /* !!#### May produce bogus data under Mule. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3661 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3662 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3663
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3664 extra = XSTRING_LENGTH (string) % CRYPT_BLOCK_SIZE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3665 rounded_size = XSTRING_LENGTH (string) + extra;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3666 encrypted_string = alloca (rounded_size + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3667 memcpy (encrypted_string, XSTRING_DATA (string), XSTRING_LENGTH (string));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3668 memset (encrypted_string + rounded_size - extra, 0, extra + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3669
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3670 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3672 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3673 memcpy (raw_key, XSTRING_DATA (key), key_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3674 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3676 ecb_crypt (raw_key, encrypted_string, rounded_size,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3677 DES_ENCRYPT | DES_SW);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3678 return make_string (encrypted_string, rounded_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3679 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3680
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3681 DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3682 Decrypt STRING using KEY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3683 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3684 (string, key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3685 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3686 /* !!#### May produce bogus data under Mule. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3687 char *decrypted_string, *raw_key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3688 int string_size, key_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3689
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3690 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3691 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3692
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3693 string_size = XSTRING_LENGTH (string) + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3694 decrypted_string = alloca (string_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3695 memcpy (decrypted_string, XSTRING_DATA (string), string_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3696 decrypted_string[string_size - 1] = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3698 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3700 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3701 memcpy (raw_key, XSTRING_DATA (key), key_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3702 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3704
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3705 ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3706 return make_string (decrypted_string, string_size - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3707 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3708 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3709
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3710
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3711 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3712 Return t if last mod time of BUFFER's visited file matches what BUFFER records.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3713 This means that the file has not been changed since it was visited or saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3714 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3715 (buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3716 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3717 /* This function can call lisp; GC checked 2000-07-11 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3718 struct buffer *b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3719 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3720 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3721
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3722 CHECK_BUFFER (buffer);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3723 b = XBUFFER (buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3724
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3725 if (!STRINGP (b->filename)) return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3726 if (b->modtime == 0) return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3727
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3728 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3729 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3730 handler = Ffind_file_name_handler (b->filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3731 Qverify_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3732 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3733 return call2 (handler, Qverify_visited_file_modtime, buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3734
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3735 if (qxe_stat (XSTRING_DATA (b->filename), &st) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3736 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3737 /* If the file doesn't exist now and didn't exist before,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3738 we say that it isn't modified, provided the error is a tame one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3739 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3740 st.st_mtime = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3741 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3742 st.st_mtime = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3743 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3744 if (st.st_mtime == b->modtime
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3745 /* If both are positive, accept them if they are off by one second. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3746 || (st.st_mtime > 0 && b->modtime > 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3747 && (st.st_mtime == b->modtime + 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3748 || st.st_mtime == b->modtime - 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3749 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3750 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3751 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3752
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3753 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3754 Clear out records of last mod time of visited file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3755 Next attempt to save will certainly not complain of a discrepancy.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3756 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3757 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3758 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3759 current_buffer->modtime = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3760 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3761 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3762
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3763 DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3764 Return the current buffer's recorded visited file modification time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3765 The value is a list of the form (HIGH . LOW), like the time values
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3766 that `file-attributes' returns.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3767 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3768 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3769 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3770 return time_to_lisp ((time_t) current_buffer->modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3771 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3773 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3774 Update buffer's recorded modification time from the visited file's time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3775 Useful if the buffer was not read from the file normally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3776 or if the file itself has been changed for some known benign reason.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3777 An argument specifies the modification time value to use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3778 \(instead of that of the visited file), in the form of a list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3779 \(HIGH . LOW) or (HIGH LOW).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3780 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3781 (time_list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3782 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3783 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3784 if (!NILP (time_list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3785 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3786 time_t the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3787 lisp_to_time (time_list, &the_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3788 current_buffer->modtime = (int) the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3789 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3790 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3791 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3792 Lisp_Object filename = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3793 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3794 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3795 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3797 GCPRO3 (filename, time_list, current_buffer->filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3798 filename = Fexpand_file_name (current_buffer->filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3800 /* If the file name has special constructs in it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3801 call the corresponding file handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3802 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3803 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3804 if (!NILP (handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3805 /* The handler can find the file name the same way we did. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3806 return call2 (handler, Qset_visited_file_modtime, Qnil);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3807 else if (qxe_stat (XSTRING_DATA (filename), &st) >= 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3808 current_buffer->modtime = st.st_mtime;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3809 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3810
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3811 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3812 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3813
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3814 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3815 auto_save_error (Lisp_Object condition_object, Lisp_Object ignored)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3816 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3817 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3818 if (gc_in_progress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3819 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3820 /* Don't try printing an error message after everything is gone! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3821 if (preparing_for_armageddon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3822 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3823 clear_echo_area (selected_frame (), Qauto_saving, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3824 Fding (Qt, Qauto_save_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3825 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3826 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3827 message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3828 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3829 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3830 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3831 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3832 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3833
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3834 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3835 auto_save_1 (Lisp_Object ignored)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3836 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3837 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3838 /* #### I think caller is protecting current_buffer? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3839 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3840 Lisp_Object fn = current_buffer->filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3841 Lisp_Object a = current_buffer->auto_save_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3843 if (!STRINGP (a))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3844 return (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3845
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3846 /* Get visited file's mode to become the auto save file's mode. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3847 if (STRINGP (fn) &&
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3848 qxe_stat (XSTRING_DATA (fn), &st) >= 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3849 /* But make sure we can overwrite it later! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3850 auto_save_mode_bits = st.st_mode | 0600;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3851 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3852 /* default mode for auto-save files of buffers with no file is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3853 readable by owner only. This may annoy some small number of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3854 people, but the alternative removes all privacy from email. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3855 auto_save_mode_bits = 0600;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3856
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3857 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3858 Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3859 #if 1 /* #### Kyle wants it changed to not use escape-quoted. Think
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3860 carefully about how this works. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3861 Qescape_quoted
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3862 #else
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
3863 current_buffer->buffer_file_coding_system
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3864 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3865 );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3866 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3867
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3868 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3869 auto_save_expand_name_error (Lisp_Object condition_object, Lisp_Object ignored)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3870 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3871 warn_when_safe_lispobj
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3872 (Qfile, Qerror,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3873 Fcons (build_msg_string ("Invalid auto-save list-file"),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3874 Fcons (Vauto_save_list_file_name,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3875 condition_object)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3876 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3877 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3878
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3879 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3880 auto_save_expand_name (Lisp_Object name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3881 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3882 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3883
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3884 /* note that caller did NOT gc protect name, so we do it. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3885 /* [[dmoore - this might not be necessary, if condition_case_1
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3886 protects it. but I don't think it does.]] indeed it doesn't. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3887 GCPRO1 (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3888 RETURN_UNGCPRO (Fexpand_file_name (name, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3889 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3890
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3891
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3892 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3893 do_auto_save_unwind (Lisp_Object fd)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3894 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
3895 retry_close (XINT (fd));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3896 return (fd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3897 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3898
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3899 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3900 do_auto_save_unwind_2 (Lisp_Object old_auto_saving)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3901 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3902 auto_saving = XINT (old_auto_saving);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3903 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3904 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3905
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3906 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3907 and if so, tries to avoid touching lisp objects.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3908
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3909 The only time that Fdo_auto_save() is called while GC is in progress
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3910 is if we're going down, as a result of an abort() or a kill signal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3911 It's fairly important that we generate autosave files in that case!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3912 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3913
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3914 DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3915 Auto-save all buffers that need it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3916 This is all buffers that have auto-saving enabled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3917 and are changed since last auto-saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3918 Auto-saving writes the buffer into a file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3919 so that your editing is not lost if the system crashes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3920 This file is not the file you visited; that changes only when you save.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3921 Normally we run the normal hook `auto-save-hook' before saving.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3922
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3923 Non-nil first argument means do not print any message if successful.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3924 Non-nil second argument means save only current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3925 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3926 (no_message, current_only))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3927 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3928 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3929 struct buffer *b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3930 Lisp_Object tail, buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3931 int auto_saved = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3932 int do_handled_files;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3933 Lisp_Object oquit = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3934 Lisp_Object listfile = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3935 Lisp_Object old;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3936 int listdesc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3937 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3938 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3939
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3940 old = wrap_buffer (current_buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3941 GCPRO3 (oquit, listfile, old);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3942 check_quit (); /* make Vquit_flag accurate */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3943 /* Ordinarily don't quit within this function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3944 but don't make it impossible to quit (in case we get hung in I/O). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3945 oquit = Vquit_flag;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3946 Vquit_flag = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3947
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3948 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3949 variables point to non-strings reached from Vbuffer_alist. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3950
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3951 if (minibuf_level != 0 || preparing_for_armageddon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3952 no_message = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3953
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3954 run_hook (Qauto_save_hook);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3955
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3956 if (STRINGP (Vauto_save_list_file_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3957 listfile = condition_case_1 (Qt,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3958 auto_save_expand_name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3959 Vauto_save_list_file_name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3960 auto_save_expand_name_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3961
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3962 /* Make sure auto_saving is reset. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3963 record_unwind_protect (do_auto_save_unwind_2, make_int (auto_saving));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3964
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3965 auto_saving = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3966
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3967 /* First, save all files which don't have handlers. If Emacs is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3968 crashing, the handlers may tweak what is causing Emacs to crash
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3969 in the first place, and it would be a shame if Emacs failed to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3970 autosave perfectly ordinary files because it couldn't handle some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3971 ange-ftp'd file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3972 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3973 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3974 for (tail = Vbuffer_alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3975 CONSP (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3976 tail = XCDR (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3977 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3978 buf = XCDR (XCAR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3979 b = XBUFFER (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3981 if (!NILP (current_only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3982 && b != current_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3983 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3984
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3985 /* Don't auto-save indirect buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3986 The base buffer takes care of it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3987 if (b->base_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3988 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3989
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3990 /* Check for auto save enabled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3991 and file changed since last auto save
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3992 and file changed since last real save. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3993 if (STRINGP (b->auto_save_file_name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3994 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3995 && b->auto_save_modified < BUF_MODIFF (b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3996 /* -1 means we've turned off autosaving for a while--see below. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3997 && XINT (b->saved_size) >= 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3998 && (do_handled_files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3999 || NILP (Ffind_file_name_handler (b->auto_save_file_name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4000 Qwrite_region))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4001 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4002 EMACS_TIME before_time, after_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4003
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4004 EMACS_GET_TIME (before_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4005 /* If we had a failure, don't try again for 20 minutes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4006 if (!preparing_for_armageddon
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4007 && b->auto_save_failure_time >= 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4008 && (EMACS_SECS (before_time) - b->auto_save_failure_time <
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4009 1200))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4010 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4011
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4012 if (!preparing_for_armageddon &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4013 (XINT (b->saved_size) * 10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4014 > (BUF_Z (b) - BUF_BEG (b)) * 13)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4015 /* A short file is likely to change a large fraction;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4016 spare the user annoying messages. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4017 && XINT (b->saved_size) > 5000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4018 /* These messages are frequent and annoying for `*mail*'. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4019 && !NILP (b->filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4020 && NILP (no_message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4021 && disable_auto_save_when_buffer_shrinks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4022 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4023 /* It has shrunk too much; turn off auto-saving here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4024 Unless we're about to crash, in which case auto-save it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4025 anyway.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4026 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4027 message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4028 ("Buffer %s has shrunk a lot; auto save turned off there",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4029 XSTRING_DATA (b->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4030 /* Turn off auto-saving until there's a real save,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4031 and prevent any more warnings. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4032 b->saved_size = make_int (-1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4033 if (!gc_in_progress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4034 Fsleep_for (make_int (1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4035 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4036 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4037 set_buffer_internal (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4038 if (!auto_saved && NILP (no_message))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4039 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4040 static const unsigned char *msg
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4041 = (const unsigned char *) "Auto-saving...";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4042 echo_area_message (selected_frame (), msg, Qnil,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4043 0, strlen ((const char *) msg),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4044 Qauto_saving);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4045 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4046
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4047 /* Open the auto-save list file, if necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4048 We only do this now so that the file only exists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4049 if we actually auto-saved any files. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4050 if (!auto_saved && !inhibit_auto_save_session
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4051 && !NILP (Vauto_save_list_file_prefix)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4052 && STRINGP (listfile) && listdesc < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4053 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4054 listdesc =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4055 qxe_open (XSTRING_DATA (listfile),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4056 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4057 CREAT_MODE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4058
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4059 /* Arrange to close that file whether or not we get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4060 an error. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4061 if (listdesc >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4062 record_unwind_protect (do_auto_save_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4063 make_int (listdesc));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4064 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4065
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4066 /* Record all the buffers that we are auto-saving in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4067 the special file that lists them. For each of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4068 these buffers, record visited name (if any) and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4069 auto save name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4070 if (listdesc >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4071 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4072 const Extbyte *auto_save_file_name_ext;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
4073 Bytecount auto_save_file_name_ext_len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4074
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4075 TO_EXTERNAL_FORMAT (LISP_STRING, b->auto_save_file_name,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4076 ALLOCA, (auto_save_file_name_ext,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4077 auto_save_file_name_ext_len),
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4078 Qescape_quoted);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4079 if (!NILP (b->filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4080 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4081 const Extbyte *filename_ext;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
4082 Bytecount filename_ext_len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4083
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4084 TO_EXTERNAL_FORMAT (LISP_STRING, b->filename,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4085 ALLOCA, (filename_ext,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
4086 filename_ext_len),
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4087 Qescape_quoted);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4088 retry_write (listdesc, filename_ext, filename_ext_len);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4089 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4090 retry_write (listdesc, "\n", 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4091 retry_write (listdesc, auto_save_file_name_ext,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4092 auto_save_file_name_ext_len);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4093 retry_write (listdesc, "\n", 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4094 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4095
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4096 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4097 based on values in Vbuffer_alist. auto_save_1 may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4098 cause lisp handlers to run. Those handlers may kill
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4099 the buffer and then GC. Since the buffer is killed,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4100 it's no longer in Vbuffer_alist so it might get reaped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4101 by the GC. We also need to protect tail. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4102 /* #### There is probably a lot of other code which has
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4103 pointers into buffers which may get blown away by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4104 handlers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4105 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4106 struct gcpro ngcpro1, ngcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4107 NGCPRO2 (buf, tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4108 condition_case_1 (Qt,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4109 auto_save_1, Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4110 auto_save_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4111 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4112 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4113 /* Handler killed our saved current-buffer! Pick any. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4114 if (!BUFFER_LIVE_P (XBUFFER (old)))
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
4115 old = wrap_buffer (current_buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4117 set_buffer_internal (XBUFFER (old));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4118 auto_saved++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4120 /* Handler killed their own buffer! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4121 if (!BUFFER_LIVE_P(b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4122 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4124 b->auto_save_modified = BUF_MODIFF (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4125 b->saved_size = make_int (BUF_SIZE (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4126 EMACS_GET_TIME (after_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4127 /* If auto-save took more than 60 seconds,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4128 assume it was an NFS failure that got a timeout. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4129 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4130 b->auto_save_failure_time = EMACS_SECS (after_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4131 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4132 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4133 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4135 /* Prevent another auto save till enough input events come in. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4136 if (auto_saved)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4137 record_auto_save ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4139 /* If we didn't save anything into the listfile, remove the old
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4140 one because nothing needed to be auto-saved. Do this afterwards
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4141 rather than before in case we get a crash attempting to autosave
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4142 (in that case we'd still want the old one around). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4143 if (listdesc < 0 && !auto_saved && STRINGP (listfile))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4144 qxe_unlink (XSTRING_DATA (listfile));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4146 /* Show "...done" only if the echo area would otherwise be empty. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4147 if (auto_saved && NILP (no_message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4148 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4149 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4150 static const unsigned char *msg
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4151 = (const unsigned char *)"Auto-saving...done";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4152 echo_area_message (selected_frame (), msg, Qnil, 0,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4153 strlen ((const char *) msg), Qauto_saving);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4154 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4156 Vquit_flag = oquit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4157
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4158 RETURN_UNGCPRO (unbind_to (speccount));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4159 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4161 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4162 Mark current buffer as auto-saved with its current text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4163 No auto-save file will be written until the buffer changes again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4164 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4165 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4166 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4167 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4168 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4169 current_buffer->auto_save_failure_time = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4170 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4171 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4173 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4174 Clear any record of a recent auto-save failure in the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4175 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4176 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4177 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4178 current_buffer->auto_save_failure_time = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4179 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4180 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4181
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4182 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4183 Return t if buffer has been auto-saved since last read in or saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4184 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4185 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4186 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4187 return (BUF_SAVE_MODIFF (current_buffer) <
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4188 current_buffer->auto_save_modified) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4189 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4190
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4191
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4192 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4193 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4194 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4196 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4197 syms_of_fileio (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4198 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4199 DEFSYMBOL (Qexpand_file_name);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4200 DEFSYMBOL (Qfile_truename);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4201 DEFSYMBOL (Qsubstitute_in_file_name);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4202 DEFSYMBOL (Qdirectory_file_name);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4203 DEFSYMBOL (Qfile_name_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4204 DEFSYMBOL (Qfile_name_nondirectory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4205 DEFSYMBOL (Qunhandled_file_name_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4206 DEFSYMBOL (Qfile_name_as_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4207 DEFSYMBOL (Qcopy_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4208 DEFSYMBOL (Qmake_directory_internal);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4209 DEFSYMBOL (Qdelete_directory);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4210 DEFSYMBOL (Qdelete_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4211 DEFSYMBOL (Qrename_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4212 DEFSYMBOL (Qadd_name_to_file);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4213 DEFSYMBOL (Qmake_symbolic_link);
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
4214 DEFSYMBOL (Qmake_temp_name);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4215 DEFSYMBOL (Qfile_exists_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4216 DEFSYMBOL (Qfile_executable_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4217 DEFSYMBOL (Qfile_readable_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4218 DEFSYMBOL (Qfile_symlink_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4219 DEFSYMBOL (Qfile_writable_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4220 DEFSYMBOL (Qfile_directory_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4221 DEFSYMBOL (Qfile_regular_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4222 DEFSYMBOL (Qfile_accessible_directory_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4223 DEFSYMBOL (Qfile_modes);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4224 DEFSYMBOL (Qset_file_modes);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4225 DEFSYMBOL (Qfile_newer_than_file_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4226 DEFSYMBOL (Qinsert_file_contents);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4227 DEFSYMBOL (Qwrite_region);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4228 DEFSYMBOL (Qverify_visited_file_modtime);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4229 DEFSYMBOL (Qset_visited_file_modtime);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4230 DEFSYMBOL (Qcar_less_than_car); /* Vomitous! */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4231
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4232 DEFSYMBOL (Qauto_save_hook);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4233 DEFSYMBOL (Qauto_save_error);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4234 DEFSYMBOL (Qauto_saving);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4235
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4236 DEFSYMBOL (Qformat_decode);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4237 DEFSYMBOL (Qformat_annotate_function);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4238
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4239 DEFSYMBOL (Qcompute_buffer_file_truename);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
4240
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4241 DEFERROR_STANDARD (Qfile_already_exists, Qfile_error);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4243 DEFSUBR (Ffind_file_name_handler);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4244
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4245 DEFSUBR (Ffile_name_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4246 DEFSUBR (Ffile_name_nondirectory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4247 DEFSUBR (Funhandled_file_name_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4248 DEFSUBR (Ffile_name_as_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4249 DEFSUBR (Fdirectory_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4250 DEFSUBR (Fmake_temp_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4251 DEFSUBR (Fexpand_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4252 DEFSUBR (Ffile_truename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4253 DEFSUBR (Fsubstitute_in_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4254 DEFSUBR (Fcopy_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4255 DEFSUBR (Fmake_directory_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4256 DEFSUBR (Fdelete_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4257 DEFSUBR (Fdelete_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4258 DEFSUBR (Frename_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4259 DEFSUBR (Fadd_name_to_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4260 DEFSUBR (Fmake_symbolic_link);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4261 #ifdef HPUX_NET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4262 DEFSUBR (Fsysnetunam);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4263 #endif /* HPUX_NET */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4264 DEFSUBR (Ffile_name_absolute_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4265 DEFSUBR (Ffile_exists_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4266 DEFSUBR (Ffile_executable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4267 DEFSUBR (Ffile_readable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4268 DEFSUBR (Ffile_writable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4269 DEFSUBR (Ffile_symlink_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4270 DEFSUBR (Ffile_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4271 DEFSUBR (Ffile_accessible_directory_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4272 DEFSUBR (Ffile_regular_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4273 DEFSUBR (Ffile_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4274 DEFSUBR (Fset_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4275 DEFSUBR (Fset_default_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4276 DEFSUBR (Fdefault_file_modes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4277 DEFSUBR (Funix_sync);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4278 DEFSUBR (Ffile_newer_than_file_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4279 DEFSUBR (Finsert_file_contents_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4280 DEFSUBR (Fwrite_region_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4281 DEFSUBR (Fcar_less_than_car); /* Vomitous! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4282 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4283 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4284 DEFSUBR (Fencrypt_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4285 DEFSUBR (Fdecrypt_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4286 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4287 DEFSUBR (Fverify_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4288 DEFSUBR (Fclear_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4289 DEFSUBR (Fvisited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4290 DEFSUBR (Fset_visited_file_modtime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4292 DEFSUBR (Fdo_auto_save);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4293 DEFSUBR (Fset_buffer_auto_saved);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4294 DEFSUBR (Fclear_buffer_auto_save_failure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4295 DEFSUBR (Frecent_auto_save_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4296 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4298 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4299 vars_of_fileio (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4300 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4301 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4302 *Format in which to write auto-save files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4303 Should be a list of symbols naming formats that are defined in `format-alist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4304 If it is t, which is the default, auto-save files are written in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4305 same format as a regular save would use.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4306 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4307 Vauto_save_file_format = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4309 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4310 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4311 If a file name matches REGEXP, then all I/O on that file is done by calling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4312 HANDLER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4314 The first argument given to HANDLER is the name of the I/O primitive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4315 to be handled; the remaining arguments are the arguments that were
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4316 passed to that primitive. For example, if you do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4317 (file-exists-p FILENAME)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4318 and FILENAME is handled by HANDLER, then HANDLER is called like this:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4319 (funcall HANDLER 'file-exists-p FILENAME)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4320 The function `find-file-name-handler' checks this list for a handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4321 for its argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4322 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4323 Vfile_name_handler_alist = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4325 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4326 A list of functions to be called at the end of `insert-file-contents'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4327 Each is passed one argument, the number of bytes inserted. It should return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4328 the new byte count, and leave point the same. If `insert-file-contents' is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4329 intercepted by a handler from `file-name-handler-alist', that handler is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4330 responsible for calling the after-insert-file-functions if appropriate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4331 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4332 Vafter_insert_file_functions = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4334 DEFVAR_LISP ("write-region-annotate-functions",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4335 &Vwrite_region_annotate_functions /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4336 A list of functions to be called at the start of `write-region'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4337 Each is passed two arguments, START and END, as for `write-region'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4338 It should return a list of pairs (POSITION . STRING) of strings to be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4339 effectively inserted at the specified positions of the file being written
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4340 \(1 means to insert before the first byte written). The POSITIONs must be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4341 sorted into increasing order. If there are several functions in the list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4342 the several lists are merged destructively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4343 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4344 Vwrite_region_annotate_functions = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4346 DEFVAR_LISP ("write-region-annotations-so-far",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4347 &Vwrite_region_annotations_so_far /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4348 When an annotation function is called, this holds the previous annotations.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4349 These are the annotations made by other annotation functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4350 that were already called. See also `write-region-annotate-functions'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4351 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4352 Vwrite_region_annotations_so_far = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4353
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4354 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4355 A list of file name handlers that temporarily should not be used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4356 This applies only to the operation `inhibit-file-name-operation'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4357 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4358 Vinhibit_file_name_handlers = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4359
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4360 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4361 The operation for which `inhibit-file-name-handlers' is applicable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4362 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4363 Vinhibit_file_name_operation = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4365 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4366 File name in which we write a list of all auto save file names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4367 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4368 Vauto_save_list_file_name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4369
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4370 DEFVAR_LISP ("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /*
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4371 Prefix for generating auto-save-list-file-name.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4372 Emacs's pid and the system name will be appended to
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4373 this prefix to create a unique file name.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4374 */ );
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4375 Vauto_save_list_file_prefix = build_string ("~/.saves-");
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4376
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4377 DEFVAR_BOOL ("inhibit-auto-save-session", &inhibit_auto_save_session /*
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4378 When non-nil, inhibit auto save list file creation.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4379 */ );
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4380 inhibit_auto_save_session = 0;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4381
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4382 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4383 &disable_auto_save_when_buffer_shrinks /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4384 If non-nil, auto-saving is disabled when a buffer shrinks too much.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4385 This is to prevent you from losing your edits if you accidentally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4386 delete a large chunk of the buffer and don't notice it until too late.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4387 Saving the buffer normally turns auto-save back on.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4388 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4389 disable_auto_save_when_buffer_shrinks = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4391 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4392 Directory separator character for built-in functions that return file names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4393 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4394 This variable affects the built-in functions only on Windows,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4395 on other platforms, it is initialized so that Lisp code can find out
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4396 what the normal separator is.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4397 */ );
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 764
diff changeset
4398 Vdirectory_sep_char = make_char (DEFAULT_DIRECTORY_SEP);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4399
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4400 reinit_vars_of_fileio ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4401 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4402
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4403 void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4404 reinit_vars_of_fileio (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4405 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4406 /* We want temp_name_rand to be initialized to a value likely to be
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4407 unique to the process, not to the executable. The danger is that
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4408 two different XEmacs processes using the same binary on different
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4409 machines creating temp files in the same directory will be
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4410 unlucky enough to have the same pid. If we randomize using
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4411 process startup time, then in practice they will be unlikely to
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4412 collide. We use the microseconds field so that scripts that start
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4413 simultaneous XEmacs processes on multiple machines will have less
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4414 chance of collision. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4415 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4416 EMACS_TIME thyme;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4417
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4418 EMACS_GET_TIME (thyme);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4419 temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4420 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4421 }