mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-17 06:42:18 -08:00
Code Issues Projects Releases Packages Wiki Activity

ENSURE-DIRECTORIES-EXIST takes a :MODE argument (POSIX mode) and protects its pathname computation by overriding *default-pathname-defaults*

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-04-13 01:03:27 +02:00
parent 441b57d3f5
commit 27bed7934c
2 changed files with 20 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/CHANGELOG
View file

@ -21,6 +21,9 @@ ECL 12.2.2:
- EXT:MKDIR no longer accepts pathnames as inputs to avoid problems with
pathnames that contain name or type components.
- ENSURE-DIRECTORIES-EXIST accepts the keyword argument :MODE which is
passed to MKDIR.
;;; Local Variables: ***
;;; mode:text ***
;;; fill-column:79 ***

29
src/lsp/mislib.lsp
View file

@ -259,7 +259,7 @@ Returns the current day-and-time as nine values:
Sunday is the *last* day of the week!!"
(decode-universal-time (get-universal-time)))
(defun ensure-directories-exist (pathname &key verbose)
(defun ensure-directories-exist (pathname &key verbose (mode #o777))
"Args: (ensure-directories pathname &key :verbose)
Creates tree of directories specified by the given pathname. Outputs
(VALUES pathname created)
@ -273,17 +273,22 @@ where CREATED is true only if we succeeded on creating all directories."
(wild-pathname-p full-pathname :host)
(wild-pathname-p full-pathname :device))
(error 'file-error :pathname pathname))
(dolist (item (pathname-directory full-pathname))
(setf d (nconc d (list item)))
(let* ((p (make-pathname :name nil :type nil :directory d
:defaults full-pathname)))
(unless (or (symbolp item) (si::file-kind p nil))
(setf created t)
(let ((ps (namestring p)))
(when verbose
(format t "~%;;; Making directory ~A" ps))
(si::mkdir ps #o777)))))
(values pathname created)))
;; Here we have already a full pathname. We set our own
;; *default-pathname-defaults* to avoid that the user's value,
;; which may contain names or types, clobbers our computations.
(let ((*default-pathname-defaults*
(make-pathname :name nil :type nil :directory nil
:defaults full-pathname)))
(dolist (item (pathname-directory full-pathname))
(setf d (nconc d (list item)))
(let* ((p (make-pathname :directory d)))
(unless (or (symbolp item) (si::file-kind p nil))
(setf created t)
(let ((ps (namestring p)))
(when verbose
(format t "~%;;; Making directory ~A" ps))
(si::mkdir ps mode)))))
(values pathname created))))
(defmacro with-hash-table-iterator ((iterator package) &body body)
"Syntax: (with-hash-table-iterator (iterator package) &body body)