mirrors
/
ambevar-dotfiles
mirror of https://gitlab.com/ambrevar/dotfiles/
1
0
Fork 0
Code Issues Releases Wiki Activity

ambrevar/file: Export file?, file=, report better error message on bad path.

master
Pierre Neidhardt 2021-01-20 16:18:48 +01:00
parent 6e957d1819
commit e9737b0686
1 changed files with 16 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
.local/share/common-lisp/source/ambrevar/file.lisp
View File

@ -22,18 +22,24 @@
(defclass* file () (defclass* file ()
((path (error "Path required") ((path (error "Path required")
:type string) :type string
;; :reader path
)
(inode 0) (inode 0)
(link-count 0) (link-count 0)
(kind :regular-file ; "kind" because `type' is reserved by CL. (kind :regular-file ; "kind" because `type' is reserved by CL.
:type (member :directory :type (member :directory
:character-device :character-device
:block-device :block-device
:regular-file :regular-file
:symbolic-link :symbolic-link
:socket :socket
:pipe)) :pipe)
(size 0) ;; :reader kind
)
(size 0
;; :reader size
)
(user-id 0) (user-id 0)
(group-id 0) (group-id 0)
;; TODO: Include blocks? ;; TODO: Include blocks?
@ -62,12 +68,15 @@ If none, return the empty string unlike `pathname-type'."
(or (pathname-type (path file)) (or (pathname-type (path file))
"")) ""))
(export 'directory?)
(defmethod directory? ((file file)) (defmethod directory? ((file file))
(eq (kind file) :directory)) (eq (kind file) :directory))
(export 'file?)
(defmethod file? ((file file)) (defmethod file? ((file file))
(eq (kind file) :regular-file)) (eq (kind file) :regular-file))
(export 'file=)
(defun file= (file1 file2) (defun file= (file1 file2)
"Return true if FILE1 and FILE2 point to the same file. "Return true if FILE1 and FILE2 point to the same file.
They might not be the same objects." They might not be the same objects."
@ -117,8 +126,9 @@ If PARENT-DIRECTORY is not a parent of PATH, return PATH."
(native-path (uiop:truename* (if (pathnamep path) (native-path (uiop:truename* (if (pathnamep path)
path path
(uiop:parse-native-namestring path))))) (uiop:parse-native-namestring path)))))
(assert (or (uiop:file-exists-p native-path) (unless (or (uiop:file-exists-p native-path)
(uiop:directory-exists-p native-path))) (uiop:directory-exists-p native-path))
(error "~s is not a file path" (or native-path path)))
;; TODO: What do we do with non-existent files (e.g. unsaved emacs buffers)? Just return nil? ;; TODO: What do we do with non-existent files (e.g. unsaved emacs buffers)? Just return nil?
(let ((stat (ignore-errors (osicat-posix:stat native-path)))) (let ((stat (ignore-errors (osicat-posix:stat native-path))))
(when stat (when stat