ambrevar/file: Fix behaviour on directories.
parent
65c7b851c4
commit
ce1733785d
|
@ -46,24 +46,43 @@ If none, return the empty string unlike `pathname-type'."
|
||||||
(or (pathname-type (path file))
|
(or (pathname-type (path file))
|
||||||
""))
|
""))
|
||||||
|
|
||||||
|
(defmethod directory? ((file file))
|
||||||
|
(eq (kind file) :directory))
|
||||||
|
|
||||||
|
(defmethod file? ((file file))
|
||||||
|
(eq (kind file) :regular-file))
|
||||||
|
|
||||||
|
(defun separator (&optional char?)
|
||||||
|
(if char?
|
||||||
|
(uiop:directory-separator-for-host)
|
||||||
|
(string (uiop:directory-separator-for-host))))
|
||||||
|
|
||||||
(export-always 'basename)
|
(export-always 'basename)
|
||||||
(defmethod basename ((file file))
|
(defmethod basename ((file file))
|
||||||
"Return the file basename (including the extension)."
|
"Return the file basename (including the extension).
|
||||||
(let ((last-separator (position (uiop:directory-separator-for-host)
|
This returns the directory name for directories."
|
||||||
(path file) :from-end t)))
|
(let* ((path (path file))
|
||||||
(subseq (path file)
|
(path (if (str:ends-with? (separator) path)
|
||||||
|
(subseq path 0 (1- (length path)))
|
||||||
|
path))
|
||||||
|
(last-separator (position (separator :char)
|
||||||
|
path :from-end t)))
|
||||||
|
(subseq path
|
||||||
(1+ last-separator))))
|
(1+ last-separator))))
|
||||||
|
|
||||||
(defmethod print-object ((file file) stream)
|
(defmethod print-object ((file file) stream)
|
||||||
(print-unreadable-object (file stream :type t :identity t)
|
(print-unreadable-object (file stream :type t :identity t)
|
||||||
(write-string (basename file) stream)))
|
(write-string (str:concat (basename file)
|
||||||
|
(when (directory? file) "/"))
|
||||||
|
stream)))
|
||||||
|
|
||||||
(export-always 'file)
|
(export-always 'file)
|
||||||
(defun file (path)
|
(defun file (path)
|
||||||
(let ((native-path (uiop:truename* (if (pathnamep path)
|
(let ((native-path (uiop:truename* (if (pathnamep path)
|
||||||
path
|
path
|
||||||
(uiop:parse-native-namestring path)))))
|
(uiop:parse-native-namestring path)))))
|
||||||
(assert (uiop:file-exists-p native-path))
|
(assert (or (uiop:file-exists-p native-path)
|
||||||
|
(uiop:directory-exists-p native-path)))
|
||||||
(let ((stat (osicat-posix:stat native-path)))
|
(let ((stat (osicat-posix:stat native-path)))
|
||||||
;; From Osicat's `file-permissions':
|
;; From Osicat's `file-permissions':
|
||||||
(flet ((stat-permissions (stat)
|
(flet ((stat-permissions (stat)
|
||||||
|
|
Loading…
Reference in New Issue