6:56 p.m.
Yes, the CODING-SYSTEM-OR-MUSTBENEW argument is ugly. No, I don’t see a
better approach to this which would be compatible with GNU, given that our
CODING-SYSTEM argument was already in 21.4.
APPROVE COMMIT
NOTE: This patch has been committed.
lisp/ChangeLog addition:
2007-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
* code-files.el (write-region):
Provide a new arg, CODING-SYSTEM-OR-MUSTBENEW, for compatibility
both with GNU (where it has the MUSTBENEW meaning) and earlier
XEmacs code (where it has the CODING-SYSTEM meaning).
* files.el:
* files.el (normal-backup-enable-predicate):
* files.el (auto-save-file-name-transforms):
Correct the docstrings of #'normal-backup-enable-predicate,
#'auto-save-file-name-transforms.
* files.el (make-temp-file): New.
Merge from GNU.
* subr.el:
Document that #'make-temp-name is now in files.el.
src/ChangeLog addition:
2007-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
* editfns.c (vars_of_editfns):
Correct the docstring of user-full-name.
* fileio.c:
* fileio.c (Fmake_temp_name):
Document that make-temp-file is available and the best approach to
this.
* fileio.c (Fwrite_region_internal):
Take a new arg, MUSTBENEW, to error if the file to be written
already exists.
* fileio.c (auto_save_1):
Update a call to Fwrite_region_internal to pass the new argument.
* fileio.c (syms_of_fileio):
Provide 'excl as a symbol, for the calls to
write-region-internal.
XEmacs Trunk source patch:
Diff command: cvs -q diff -Nu
Files affected: src/fileio.c
===================================================================
RCS src/editfns.c
===================================================================
RCS lisp/subr.el
===================================================================
RCS lisp/files.el
===================================================================
RCS lisp/code-files.el
===================================================================
RCS
Index: lisp/code-files.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/code-files.el,v
retrieving revision 1.22
diff -u -u -r1.22 code-files.el
--- lisp/code-files.el 2007/10/02 20:09:01 1.22
+++ lisp/code-files.el 2007/11/14 18:34:22
＠＠ -514,7 +514,8 ＠＠
corresponding arguments in the call to `write-region'.")
(defun write-region (start end filename
- &optional append visit lockname coding-system)
+ &optional append visit lockname
+ coding-system-or-mustbenew)
"Write current region into specified file.
By default the file's existing contents are replaced by the specified region.
Called interactively, prompts for a file name. With a prefix arg, prompts
＠＠ -536,25 +537,40 ＠＠
use for locking and unlocking, overriding FILENAME and VISIT.
Kludgy feature: if START is a string, then that string is written
to the file, instead of any buffer contents, and END is ignored.
-Optional seventh argument CODING-SYSTEM specifies the coding system
- used to encode the text when it is written out, and defaults to
- the value of `buffer-file-coding-system' in the current buffer.
+
+Optional seventh argument CODING-SYSTEM-OR-MUSTBENEW has a rather kludgy
+ interpretation. If it is a coding system it describes the coding system
+ used to encode the text when it is written out, defaulting to to the value
+ of `buffer-file-coding-system' in the current buffer.
+
+If CODING-SYSTEM-OR-MUSTBENEW is non-nil and not a coding system, it means
+ that a check for an existing file with the same name should be made; with
+ a value of 'excl XEmacs will error if the file already exists and never
+ overwrite it. If it is some other non-nil non-coding-system value, the
+ user will be asked for confirmation if the file already exists, and the
+ file will be overwritten if confirmation is given.
+
See also `write-region-pre-hook' and `write-region-post-hook'."
(interactive "r\nFWrite region to file: \ni\ni\ni\nZCoding-system: ")
- (setq coding-system
- (or coding-system-for-write
- (run-hook-with-args-until-success
- 'write-region-pre-hook
- start end filename append visit lockname coding-system)
- coding-system
- buffer-file-coding-system
- (find-file-coding-system-for-write-from-filename filename)
- ))
- (if (consp coding-system)
- ;; One of the `write-region-pre-hook' functions wrote the file
- coding-system
- (let ((func
- (coding-system-property coding-system 'pre-write-conversion)))
+ (let (mustbenew coding-system func hook-result)
+ (setq hook-result
+ (or coding-system-for-write
+ (run-hook-with-args-until-success
+ 'write-region-pre-hook
+ start end filename append visit lockname
+ coding-system-or-mustbenew)
+ coding-system
+ buffer-file-coding-system
+ (find-file-coding-system-for-write-from-filename filename)))
+ (if (consp hook-result)
+ ;; One of the `write-region-pre-hook' functions wrote the file.
+ hook-result
+ ;; The hooks didn't do the work; do it ourselves.
+ (setq mustbenew (unless (coding-system-p coding-system-or-mustbenew)
+ coding-system-or-mustbenew)
+ coding-system (cond ((coding-system-p hook-result) hook-result)
+ ((null mustbenew) coding-system-or-mustbenew))
+ func (coding-system-property coding-system 'pre-write-conversion))
(if func
(let ((curbuf (current-buffer))
(tempbuf (generate-new-buffer " *temp-write-buffer*"))
＠＠ -569,7 +585,8 ＠＠
append
(if (eq visit t) nil visit)
lockname
- coding-system))
+ coding-system
+ mustbenew))
;; leaving a buffer associated with file will cause problems
;; when next visiting.
(kill-buffer tempbuf)
＠＠ -579,7 +596,7 ＠＠
(set-buffer-modified-p nil)
(if (buffer-file-name) (set-visited-file-modtime))))))
(write-region-internal start end filename append visit lockname
- coding-system)))
+ coding-system mustbenew)))
(run-hook-with-args 'write-region-post-hook
start end filename append visit lockname
coding-system)))
Index: lisp/files.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/files.el,v
retrieving revision 1.79
diff -u -u -r1.79 files.el
--- lisp/files.el 2007/08/31 08:34:27 1.79
+++ lisp/files.el 2007/11/14 18:34:23
＠＠ -163,8 +163,8 ＠＠
(defun normal-backup-enable-predicate (name)
"Default `backup-enable-predicate' function.
-Checks for files in `temporary-file-directory' or
-`small-temporary-file-directory'."
+Checks for files in the directory returned by `temp-directory' or specified
+by `small-temporary-file-directory'."
(let ((temporary-file-directory (temp-directory)))
(not (or (let ((comp (compare-strings temporary-file-directory 0 nil
name 0 nil)))
＠＠ -330,9 +330,8 ＠＠
When one transform applies, its result is final;
no further transforms are tried.
-The default value is set up to put the auto-save file into the
-temporary directory (see the variable `temporary-file-directory') for
-editing a remote file."
+The default value is set up to put the auto-save file into the temporary
+directory (see the function `temp-directory') for editing a remote file."
:group 'auto-save
:type '(repeat (list (string :tag "Regexp") (string :tag
"Replacement")))
;:version "21.1"
＠＠ -715,6 +714,51 ＠＠
(setq newname (expand-file-name tem (file-name-directory newname)))
(setq count (1- count))))
newname))
+
+(defun make-temp-file (prefix &optional dir-flag suffix)
+ "Create a temporary file.
+The returned file name (created by appending some random characters at the
+end of PREFIX, and expanding against the return value of `temp-directory' if
+necessary), is guaranteed to point to a newly created empty file. You can
+then use `write-region' to write new data into the file.
+
+If DIR-FLAG is non-nil, create a new empty directory instead of a file.
+
+If SUFFIX is non-nil, add that at the end of the file name.
+
+This function is analagous to mkstemp(3) under POSIX, avoiding the race
+condition between testing for the existence of the generated filename (under
+POSIX with mktemp(3), under Emacs Lisp with `make-temp-name') and creating
+it."
+ (let ((umask (default-file-modes))
+ (temporary-file-directory (temp-directory))
+ file)
+ (unwind-protect
+ (progn
+ ;; Create temp files with strict access rights. It's easy to
+ ;; loosen them later, whereas it's impossible to close the
+ ;; time-window of loose permissions otherwise.
+ (set-default-file-modes #o700)
+ (while (condition-case ()
+ (progn
+ (setq file
+ (make-temp-name
+ (expand-file-name prefix
+ temporary-file-directory)))
+ (if suffix
+ (setq file (concat file suffix)))
+ (if dir-flag
+ (make-directory file)
+ (write-region "" nil file nil 'silent nil 'excl))
+ nil)
+ (file-already-exists t))
+ ;; the file was somehow created by someone else between
+ ;; `make-temp-name' and `write-region', let's try again.
+ nil)
+ file)
+ ;; Reset the umask.
+ (set-default-file-modes umask))))
+
(defun switch-to-other-buffer (arg)
"Switch to the previous buffer. With a numeric arg, n, switch to the nth
Index: lisp/subr.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/subr.el,v
retrieving revision 1.42
diff -u -u -r1.42 subr.el
--- lisp/subr.el 2007/10/01 08:07:41 1.42
+++ lisp/subr.el 2007/11/14 18:34:23
＠＠ -1678,7 +1678,7 ＠＠
;; assq-del-all in obsolete.el.
-;; (defun make-temp-file (prefix &optional dir-flag suffix) #### doesn't exist.
+;; make-temp-file in files.el.
;; add-minor-mode in modeline.el.
Index: src/editfns.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/editfns.c,v
retrieving revision 1.54
diff -u -u -r1.54 editfns.c
--- src/editfns.c 2007/10/02 19:31:31 1.54
+++ src/editfns.c 2007/11/14 18:34:23
＠＠ -2541,8 +2541,8 ＠＠
DEFVAR_LISP ("user-full-name", &Vuser_full_name /*
*The name of the user.
-The function `user-full-name', which will return the value of this
- variable, when called without arguments.
+The function `user-full-name' will return the value of this variable, when
+called without arguments.
This is initialized to the value of the NAME environment variable.
*/ );
/* Initialized at run-time. */
Index: src/fileio.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/fileio.c,v
retrieving revision 1.112
diff -u -u -r1.112 fileio.c
--- src/fileio.c 2007/02/22 16:19:43 1.112
+++ src/fileio.c 2007/11/14 18:34:24
＠＠ -122,6 +122,7 ＠＠
static Lisp_Object Vinhibit_file_name_operation;
Lisp_Object Qfile_already_exists;
+Lisp_Object Qexcl;
Lisp_Object Qauto_save_hook;
Lisp_Object Qauto_save_error;
＠＠ -623,11 +624,12 ＠＠
In addition, this function makes an attempt to choose a name that
does not specify an existing file. To make this work, PREFIX should
-be an absolute file name. A reasonable idiom is
+be an absolute file name.
-\(make-temp-name (expand-file-name "myprefix" (temp-directory)))
-
-which puts the file in the OS-specified temporary directory.
+This function is analagous to mktemp(3) under POSIX, and as with it, there
+exists a race condition between the test for the existence of the new file
+and its creation. See `make-temp-name' for a function which avoids this
+race condition by specifying the appropriate flags to `write-region'.
*/
(prefix))
{
＠＠ -3313,21 +3315,31 ＠＠
return Qnil;
}
-DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7,
+DEFUN ("write-region-internal", Fwrite_region_internal, 3, 8,
"r\nFWrite region to file: ", /*
Write current region into specified file; no coding-system frobbing.
-This function is identical to `write-region' except for the handling
-of the CODESYS argument under XEmacs/Mule. (When Mule support is not
-present, both functions are identical and ignore the CODESYS argument.)
-If support for Mule exists in this Emacs, the file is encoded according
-to the value of CODESYS. If this is nil, no code conversion occurs.
+
+This function is almost identical to `write-region'; see that function for
+documentation of the START, END, FILENAME, APPEND, VISIT, and LOCKNAME
+arguments. CODESYS specifies the encoding to be used for the file; if it is
+nil, no code conversion occurs. (With `write-region' the coding system is
+determined automatically if not specified.)
+
+MUSTBENEW specifies that a check for an existing file of the same name
+should be made. If it is 'excl, XEmacs will error on detecting such a file
+and never write it. If it is some other non-nil value, the user will be
+prompted to confirm the overwriting of an existing file. If it is nil,
+existing files are silently overwritten when file system permissions allow
+this.
As a special kludge to support auto-saving, when START is nil START and
END are set to the beginning and end, respectively, of the buffer,
regardless of any restrictions. Don't use this feature. It is documented
here because write-region handler writers need to be aware of it.
+
*/
- (start, end, filename, append, visit, lockname, codesys))
+ (start, end, filename, append, visit, lockname, codesys,
+ mustbenew))
{
/* This function can call lisp. GC checked 2000-07-28 ben */
int desc;
＠＠ -3372,6 +3384,9 ＠＠
{
Lisp_Object handler;
+ if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
+ barf_or_query_if_file_exists (filename, "overwrite", 1, NULL);
+
if (visiting_other)
visit_file = Fexpand_file_name (visit, Qnil);
else
＠＠ -3433,12 +3448,14 ＠＠
desc = -1;
if (!NILP (append))
{
- desc = qxe_open (XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0);
+ desc = qxe_open (XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY
+ | (EQ (mustbenew, Qexcl) ? O_EXCL : 0), 0);
}
if (desc < 0)
{
desc = qxe_open (XSTRING_DATA (fn),
- O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
+ O_WRONLY | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC)
+ | O_CREAT | OPEN_BINARY,
auto_saving ? auto_save_mode_bits : CREAT_MODE);
}
＠＠ -4007,11 +4024,11 ＠＠
Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
#if 1 /* #### Kyle wants it changed to not use escape-quoted. Think
carefully about how this works. */
- Qescape_quoted
+ Qescape_quoted,
#else
- current_buffer->buffer_file_coding_system
+ current_buffer->buffer_file_coding_system,
#endif
- );
+ Qnil);
}
static Lisp_Object
＠＠ -4367,6 +4384,7 ＠＠
DEFSYMBOL (Qverify_visited_file_modtime);
DEFSYMBOL (Qset_visited_file_modtime);
DEFSYMBOL (Qcar_less_than_car); /* Vomitous! */
+ DEFSYMBOL (Qexcl);
DEFSYMBOL (Qauto_save_hook);
DEFSYMBOL (Qauto_save_error);
--
On the quay of the little Black Sea port, where the rescued pair came once
more into contact with civilization, Dobrinton was bitten by a dog which was
assumed to be mad, though it may only have been indiscriminating. (Saki)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches