Mercurial > hg > xemacs-beta
changeset 4266:c5a2b80bc4fa
[xemacs-hg @ 2007-11-14 18:51:20 by aidan]
Import make-temp-name (the functionality of mkstemp(3)) from GNU.
| author | aidan |
|---|---|
| date | Wed, 14 Nov 2007 18:51:31 +0000 |
| parents | dc697b1b786f |
| children | 66e2714696bd |
| files | lisp/ChangeLog lisp/code-files.el lisp/files.el lisp/subr.el src/ChangeLog src/editfns.c src/fileio.c |
| diffstat | 7 files changed, 157 insertions(+), 45 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Wed Nov 14 18:20:42 2007 +0000 +++ b/lisp/ChangeLog Wed Nov 14 18:51:31 2007 +0000 @@ -1,3 +1,19 @@ +2007-11-14 Aidan Kehoe <kehoea@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. + 2007-11-08 Aidan Kehoe <kehoea@parhasard.net> * cus-edit.el (custom-save-all):
--- a/lisp/code-files.el Wed Nov 14 18:20:42 2007 +0000 +++ b/lisp/code-files.el Wed Nov 14 18:51:31 2007 +0000 @@ -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)))
--- a/lisp/files.el Wed Nov 14 18:20:42 2007 +0000 +++ b/lisp/files.el Wed Nov 14 18:51:31 2007 +0000 @@ -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
--- a/lisp/subr.el Wed Nov 14 18:20:42 2007 +0000 +++ b/lisp/subr.el Wed Nov 14 18:51:31 2007 +0000 @@ -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.
--- a/src/ChangeLog Wed Nov 14 18:20:42 2007 +0000 +++ b/src/ChangeLog Wed Nov 14 18:51:31 2007 +0000 @@ -1,3 +1,20 @@ +2007-11-14 Aidan Kehoe <kehoea@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. + 2007-11-05 Didier Verna <didier@xemacs.org> * glyphs.c (potential_pixmap_file_instanciator): Fix comment
--- a/src/editfns.c Wed Nov 14 18:20:42 2007 +0000 +++ b/src/editfns.c Wed Nov 14 18:51:31 2007 +0000 @@ -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. */
--- a/src/fileio.c Wed Nov 14 18:20:42 2007 +0000 +++ b/src/fileio.c Wed Nov 14 18:51:31 2007 +0000 @@ -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 - -\(make-temp-name (expand-file-name "myprefix" (temp-directory))) - -which puts the file in the OS-specified temporary directory. +be an absolute file name. + +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);