Align cwd and umask.

This commit is contained in:
mainzelm 2002-03-05 16:49:58 +00:00
parent b4312d028c
commit 87d82f5011
1 changed files with 29 additions and 26 deletions

View File

@ -37,27 +37,29 @@
;;; Abstract out common code for create-{directory,fifo,hard-link,symlink}:
(define (create-file-thing fname makeit override? op-name syscall)
(let ((query (lambda ()
(y-or-n? (string-append op-name ": " fname
" already exists. Delete")))))
(let ((result
(let loop ((override? override?))
(with-errno-handler
((err data)
((errno/exist)
(cond ((if (eq? override? 'query)
(query)
override?)
(delete-filesys-object fname)
(loop #t))
(with-cwd-aligned
(with-umask-aligned
(let ((query (lambda ()
(y-or-n? (string-append op-name ": " fname
" already exists. Delete")))))
(let ((result
(let loop ((override? override?))
(with-errno-handler
((err data)
((errno/exist)
(cond ((if (eq? override? 'query)
(query)
override?)
(delete-filesys-object fname)
(loop #t))
;;; raising an error here won't work due to S48's
;;; broken exception system
(else (list err syscall fname)))))
(makeit fname)
#f))))
(if (list? result)
(apply errno-error result)
(if #f #f)))))
(else (list err syscall fname)))))
(makeit fname)
#f))))
(if (list? result)
(apply errno-error result)
(if #f #f)))))))
;;;;;;;
@ -106,10 +108,11 @@
;;; us not to. That's life in the food chain.
(define (rename-file old-fname new-fname . maybe-override?)
(let ((override? (:optional maybe-override? #f)))
(if (or (and override? (not (eq? override? 'query)))
(file-not-exists? new-fname)
(and override?
(y-or-n? (string-append "rename-file:" new-fname
" already exists. Delete"))))
(%rename-file old-fname new-fname))))
(with-cwd-aligned
(let ((override? (:optional maybe-override? #f)))
(if (or (and override? (not (eq? override? 'query)))
(file-not-exists? new-fname)
(and override?
(y-or-n? (string-append "rename-file:" new-fname
" already exists. Delete"))))
(%rename-file old-fname new-fname)))))