Align cwd and umask.
This commit is contained in:
parent
b4312d028c
commit
87d82f5011
|
@ -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)))))
|
||||
|
|
Loading…
Reference in New Issue