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