From: teranisi Date: Thu, 3 Jul 2003 12:11:43 +0000 (+0000) Subject: * poe.el (toplevel): Fixed the compile-time check for the definition of X-Git-Tag: apel-10_6~2 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=37e12c38da05e4ceb553461dd7b467a992e97fdb;p=elisp%2Fapel.git * poe.el (toplevel): Fixed the compile-time check for the definition of `make-temp-file' [apel-ja: 00874]. (make-temp-file) [no make-temp-file, single-user system]: Don't use set-default-file-modes nor default-file-modes. --- diff --git a/ChangeLog b/ChangeLog index 7c97fd1..3a7f2b8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,10 @@ 2003-07-03 Yuuichi Teranishi + * poe.el (toplevel): Fixed the compile-time check for the definition of + `make-temp-file' [apel-ja: 00874]. + (make-temp-file) [no make-temp-file, single-user system]: + Don't use set-default-file-modes nor default-file-modes. + * poe-18.el (make-directory-internal): Signal an error according to the exit status of mkdir. (delete-directory): New function. diff --git a/poe.el b/poe.el index 8231606..c66a5bb 100644 --- a/poe.el +++ b/poe.el @@ -1595,26 +1595,55 @@ See `walk-windows' for the meaning of MINIBUF and FRAME." (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))) "The directory for writing temporary files.") -;; Emacs 21: Create a temporary file. (lisp/subr.el) -;; Emacs 21.1-21.3 -;; (make-temp-file PREFIX &optional DIR-FLAG) -;; Emacs 21.3.x(?) and later +;; Emacs 21 CVS ; nothing to do. ;; (make-temp-file PREFIX &optional DIR-FLAG SUFFIX) -(static-condition-case nil - ;; compile-time check - (progn - (delete-file (make-temp-file "EMU" nil ".txt")) - (if (get 'make-temp-file 'defun-maybe) - (error "`make-temp-file' is already defined"))) - (wrong-number-of-arguments ; Emacs 21.1-21.3 - ;; load-time check. - ;; Replace original definition. - (or (fboundp 'si:make-temp-file) - (progn - (fset 'si:make-temp-file (symbol-function 'make-temp-file)) - (put 'make-temp-file 'defun-maybe t) - (defun make-temp-file (prefix &optional dir-flag suffix) - "\ +;; +;; Emacs 21.1-21.3 ; replace with CVS version of `make-temp-file'. +;; (make-temp-file PREFIX &optional DIR-FLAG) +;; +;; Emacs 20 and earlier ; install our version of `make-temp-file', for +;; or XEmacs ; single-user system or for multi-user system. +(eval-when-compile + (cond + ((get 'make-temp-file 'defun-maybe) + ;; this form is already evaluated during compilation. + ) + ((not (fboundp 'make-temp-file)) + ;; Emacs 20 and earlier, or XEmacs. + (put 'make-temp-file 'defun-maybe 'none)) + (t + (let* ((object (symbol-function 'make-temp-file)) + (arglist (cond + ((byte-code-function-p object) + (if (fboundp 'compiled-function-arglist) + (compiled-function-arglist object) + (aref object 0))) + ((eq (car-safe object) 'lambda) + (nth 1 object)) + ;; `make-temp-file' is a built-in. + ))) + ;; arglist: (prefix &optional dir-flag suffix) + (cond + ((not arglist) + ;; `make-temp-file' is a built-in; expects 3-args. + (put 'make-temp-file 'defun-maybe '3-args)) + ((> (length arglist) 3) + ;; Emacs 21 CVS. + (put 'make-temp-file 'defun-maybe '3-args)) + (t + ;; Emacs 21.1-21.3 + (put 'make-temp-file 'defun-maybe '2-args))))))) + +(static-cond + ((eq (get 'make-temp-file 'defun-maybe) '3-args) + (put 'make-temp-file 'defun-maybe '3-args)) + ((eq (get 'make-temp-file 'defun-maybe) '2-args) + (put 'make-temp-file 'defun-maybe '2-args) + (or (fboundp 'si:make-temp-file) + (fset 'si:make-temp-file (symbol-function 'make-temp-file))) + (setq current-load-list (cons 'make-temp-file current-load-list)) + (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 `temporary-file-directory' if necessary), @@ -1624,46 +1653,43 @@ 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." - (let ((umask (default-file-modes)) - file) - (unwind-protect - (progn - ;; Create temp files with strict access rights. - ;; It's easy toloosen them later, whereas it's impossible - ;; to close the time-window of loose permissions otherwise. - (set-default-file-modes ?\700) - (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)))) - ;; for `load-history'. - (setq current-load-list (cons 'make-temp-file current-load-list))))) - (error)) ; found our definition or no definition at compile-time. - -;; For the Emacsen which don't have make-temp-file. -(cond - ;; must be load-time check to share .elc between different systems. - ((fboundp 'make-temp-file)) - ((memq system-type '(windows-nt ms-dos OS/2 emx)) - ;; For single-user systems: - (defun-maybe make-temp-file (prefix &optional dir-flag suffix) - "Create a temporary file. + (let ((umask (default-file-modes)) + file) + (unwind-protect + (progn + ;; Create temp files with strict access rights. + ;; It's easy toloosen them later, whereas it's impossible + ;; to close the time-window of loose permissions otherwise. + (set-default-file-modes ?\700) + (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))))) + ((eq (get 'make-temp-file 'defun-maybe) 'none) + (put 'make-temp-file 'defun-maybe 'none) + (setq current-load-list (cons 'make-temp-file current-load-list)) + ;; must be load-time check to share .elc between different systems. + (cond + ((memq system-type '(windows-nt ms-dos OS/2 emx)) + ;; for single-user systems. + (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 `temporary-file-directory' if necessary), is guaranteed to point to a newly created empty file. @@ -1672,17 +1698,18 @@ 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." - (let ((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)) - file))) - (t - (defun-maybe make-temp-file (prefix &optional dir-flag suffix) - "Create a temporary file. + (let ((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)) + file))) + (t + ;; for multi-user systems. + (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 `temporary-file-directory' if necessary), is guaranteed to point to a newly created empty file. @@ -1691,71 +1718,66 @@ 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." - (let ((umask (default-file-modes))) - (unwind-protect - (let ((prefix (expand-file-name prefix temporary-file-directory))) - ;; 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 448) - (if dir-flag - ;; Create a new empty directory. - (let (dir) + (let ((prefix (expand-file-name prefix temporary-file-directory))) + (if dir-flag + ;; Create a new empty directory. + (let (dir) + (while (condition-case () + (progn + (setq dir (make-temp-name prefix)) + (if suffix + (setq dir (concat dir suffix))) + ;; `make-directory' returns nil for success, + ;; otherwise signals an error. + (make-directory dir)) + ;; the dir was somehow created by someone else + ;; between `make-temp-name' and `make-directory', + ;; let's try again. + (file-already-exists t))) + (set-file-modes dir 448) + dir) + ;; Create a new empty file. + (let (tempdir tempfile) + (unwind-protect + (let (file) + ;; First, create a temporary directory. (while (condition-case () (progn - (setq dir (make-temp-name prefix)) + (setq tempdir (make-temp-name + (concat + (file-name-directory prefix) + "DIR"))) + ;; return nil or signal an error. + (make-directory tempdir)) + ;; let's try again. + (file-already-exists t))) + (set-file-modes tempdir 448) + ;; Second, create a temporary file in the tempdir. + ;; There *is* a race condition between `make-temp-name' + ;; and `write-region', but we don't care it since we are + ;; in a private directory now. + (setq tempfile (make-temp-name (concat tempdir "/EMU"))) + (write-region "" nil tempfile nil 'silent) + (set-file-modes tempfile 384) + ;; Finally, make a hard-link from the tempfile. + (while (condition-case () + (progn + (setq file (make-temp-name prefix)) (if suffix - (setq dir (concat dir suffix))) - ;; `make-directory' returns nil for success, - ;; otherwise signals an error. - (make-directory dir)) - ;; the dir was somehow created by someone else - ;; between `make-temp-name' and `make-directory', + (setq file (concat file suffix))) + ;; return nil or signal an error. + (add-name-to-file tempfile file)) ;; let's try again. (file-already-exists t))) - dir) - ;; Create a new empty file. - (let (tempdir tempfile) - (unwind-protect - (let (file) - ;; First, create a temporary directory. - (while (condition-case () - (progn - (setq tempdir (make-temp-name - (concat - (file-name-directory prefix) - "DIR"))) - ;; return nil or signal an error. - (make-directory tempdir)) - ;; let's try again. - (file-already-exists t))) - ;; Second, create a temporary file in the tempdir. - ;; There *is* a race condition between `make-temp-name' - ;; and `write-region', but we don't care it since we are - ;; in a private directory now. - (setq tempfile (make-temp-name (concat tempdir "/EMU"))) - (write-region "" nil tempfile nil 'silent) - ;; Finally, make a hard-link from the tempfile. - (while (condition-case () - (progn - (setq file (make-temp-name prefix)) - (if suffix - (setq file (concat file suffix))) - ;; return nil or signal an error. - (add-name-to-file tempfile file)) - ;; let's try again. - (file-already-exists t))) - file) - ;; Cleanup the tempfile. - (and tempfile - (file-exists-p tempfile) - (delete-file tempfile)) - ;; Cleanup the tempdir. - (and tempdir - (file-directory-p tempdir) - (delete-directory tempdir)))))) - ;; Reset the umask. - (set-default-file-modes umask)))))) + file) + ;; Cleanup the tempfile. + (and tempfile + (file-exists-p tempfile) + (delete-file tempfile)) + ;; Cleanup the tempdir. + (and tempdir + (file-directory-p tempdir) + (delete-directory tempdir))))))))))) ;; Actually, `path-separator' is defined in src/emacs.c and overrided ;; in dos-w32.el.