make-temp-file definition is not effective

[Yuuichi Teranishi]

At 30 Jun 2003 14:17:15 +0900,
Shuhei KOBAYASHI wrote:
> 
> > 邪悪と書きましたが, 最後のがよさそうな気がしてきました. どうでしょうか?
> 
> この方針でとりあえず作ってみましたがもうちょっと整理が必要な気がします.

うーむ、こんなことができるとは…。
手元にあった XEmacs21.4.12, Emacs21.2, Mule 2.3 ＠ 19.34 で動作することは
確認できました。

これに default-file-modes が無い Emacs への対応もつけてみました。
(Nemacs 3.3.2 ＠ 18.59 で動作)

-------------- next part --------------
;; Emacs 21 CVS         ; nothing to do.
;;  (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)))))
      ;; arglist: (prefix &optional dir-flag suffix)
      (if (> (length arglist) 3)
          ;; Emacs 21 CVS.
          (put 'make-temp-file 'defun-maybe '3-args)
        ;; Emacs 21.1-21.3
        (put 'make-temp-file 'defun-maybe '2-args))))))
;;; (symbol-plist 'make-temp-file)
;;; (setplist 'make-temp-file nil)

(static-cond
 ((eq (get 'make-temp-file 'defun-maybe) '3-args)
  (put 'make-temp-file 'defun-maybe t))  ; XXX
 ((eq (get 'make-temp-file 'defun-maybe) '2-args)
  (put 'make-temp-file 'defun-maybe t)
  (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),
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."
    (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)))))
 (t ; (eq (get 'make-temp-file 'defun-maybe) 'none)
  (put 'make-temp-file 'defun-maybe t)
  (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.
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)))
   ;; for multi-user system.
   ((not (fboundp 'default-file-modes))
    ;; Emacs 19.x(?) or earlier does not have
    ;; `default-file-modes' nor `set-default-file-modes'.
    (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.
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 ((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)))
			   (let ((status (shell-command
					  (format "umask 077; mkdir %s"
						  dir))))
			     (when (and (numberp status)
					(not (zerop status)))
			       (error "make directory failed."))))
		       ;; the dir was somehow created by someone else
		       ;; between `make-temp-name' and `make-directory',
		       ;; let's try again.
		       (error 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.
			       (let ((status (shell-command
					      (format "umask 077; mkdir %s"
						      tempdir))))
				 (when (and (numberp status)
					    (not (zerop status)))
				   (error "make directory failed."))))
			   (error 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")))
		  (with-temp-buffer
		    (write-region (point-min)
				  (point-max) tempfile nil 'silent))
		  (set-file-modes tempfile 448)
		  ;; 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)
		   (call-process "rmdir" nil nil nil tempdir))))))))
   (t
    ;; Emacs 19.x(?) and later.
    (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.
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)
                    (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)))
                    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))))))))

-------------- next part --------------
--
Yuuichi Teranishi (寺西裕一) <teranisi ＠ gohome.org>
GPG Public Key: http://www.gohome.org/gpg/teranisi.asc
"Love is needing to be loved..."