165 lines
6.6 KiB
Common Lisp
165 lines
6.6 KiB
Common Lisp
(uiop:define-package ambrevar/file
|
|
(:documentation "File class.")
|
|
(:use #:common-lisp)
|
|
(:use #:trivia)
|
|
(:import-from #:hu.dwim.defclass-star #:defclass*)
|
|
(:import-from #:serapeum #:export-always))
|
|
(in-package #:ambrevar/file)
|
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
(trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria)
|
|
(trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum))
|
|
|
|
(sera:eval-always
|
|
(defun name-identity (name definition)
|
|
(declare (ignore definition))
|
|
name))
|
|
|
|
(defclass* file ()
|
|
((path (error "Path required")
|
|
:type string)
|
|
(inode 0)
|
|
(link-count 0)
|
|
(kind :regular-file ; "kind" because `type' is reserved by CL.
|
|
:type (member :directory
|
|
:character-device
|
|
:block-device
|
|
:regular-file
|
|
:symbolic-link
|
|
:socket
|
|
:pipe))
|
|
(size 0)
|
|
(user-id 0)
|
|
(group-id 0)
|
|
;; TODO: Include blocks?
|
|
(creation-date (local-time:unix-to-timestamp 0))
|
|
(modification-date (local-time:unix-to-timestamp 0))
|
|
(access-date (local-time:unix-to-timestamp 0))
|
|
(permissions '()
|
|
:type (or null
|
|
(cons #.(cons 'member (mapcar #'first osicat::+permissions+))))))
|
|
(:accessor-name-transformer #'name-identity))
|
|
|
|
(export-always 'extension)
|
|
(defmethod extension ((file file))
|
|
"Return the file extension.
|
|
If none, return the empty string unlike `pathname-type'."
|
|
(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)
|
|
(defmethod basename ((file file))
|
|
"Return the file basename (including the extension).
|
|
This returns the directory name for directories."
|
|
(let* ((path (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))))
|
|
|
|
(defmethod print-object ((file file) stream)
|
|
(print-unreadable-object (file stream :type t :identity t)
|
|
(write-string (str:concat (basename file)
|
|
(when (directory? file) "/"))
|
|
stream)))
|
|
|
|
(export-always 'file)
|
|
(defun file (path)
|
|
(let ((native-path (uiop:truename* (if (pathnamep path)
|
|
path
|
|
(uiop:parse-native-namestring path)))))
|
|
(assert (or (uiop:file-exists-p native-path)
|
|
(uiop:directory-exists-p native-path)))
|
|
;; 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))))
|
|
(when stat
|
|
;; From Osicat's `file-permissions':
|
|
(flet ((stat-permissions (stat)
|
|
(let ((mode (osicat-posix:stat-mode stat)))
|
|
(loop for (name . value) in osicat::+permissions+
|
|
when (plusp (logand mode value))
|
|
collect name))))
|
|
(make-instance 'file
|
|
:path (uiop:unix-namestring native-path)
|
|
:inode (osicat-posix:stat-ino stat)
|
|
:link-count (osicat-posix:stat-nlink stat)
|
|
:kind (osicat:file-kind native-path) ; TODO: Don't recall `stat'.
|
|
:size (osicat-posix:stat-size stat)
|
|
:user-id (osicat-posix:stat-uid stat)
|
|
:group-id (osicat-posix:stat-gid stat)
|
|
:creation-date (local-time:unix-to-timestamp (osicat-posix:stat-ctime stat))
|
|
:modification-date (local-time:unix-to-timestamp (osicat-posix:stat-mtime stat))
|
|
:access-date (local-time:unix-to-timestamp (osicat-posix:stat-atime stat))
|
|
:permissions (stat-permissions stat)))))))
|
|
|
|
(export-always 'list-directory)
|
|
(defun list-directory (&optional (path *default-pathname-defaults*) sort)
|
|
"Return entries in PATH.
|
|
By default, directories come first.
|
|
If SORT is non nil, sort them alphabetically.
|
|
Second value is the list of directories, third value is the non-directories."
|
|
;; TODO: Use locale to sort?
|
|
(let* ((subdirs (mapcar #'file (uiop:subdirectories path)))
|
|
(subfiles (mapcar #'file (uiop:directory-files path)))
|
|
(result (append subdirs subfiles)))
|
|
(values
|
|
(if sort
|
|
(sort result #'string< :key #'path)
|
|
result)
|
|
subdirs
|
|
subfiles)))
|
|
|
|
(export-always '*finder-include-directories*)
|
|
(defvar *finder-include-directories* t
|
|
"When non-nil `walk' include directories.")
|
|
|
|
(export-always 'walk)
|
|
(defun walk (root &rest predicates)
|
|
"List FILES (including directories) that satisfy all PREDICATES.
|
|
Without PREDICATES, list all files."
|
|
(let ((result '()))
|
|
(uiop:collect-sub*directories
|
|
(uiop:ensure-directory-pathname root)
|
|
(constantly t) (constantly t)
|
|
(lambda (subdirectory)
|
|
(setf result (nconc result
|
|
(let ((subfiles (mapcar #'file (append (if *finder-include-directories* (list subdirectory) nil)
|
|
(uiop:directory-files subdirectory)))))
|
|
(if predicates
|
|
(delete-if (lambda (file)
|
|
(notany (lambda (pred) (funcall pred file))
|
|
predicates))
|
|
subfiles)
|
|
subfiles))))))
|
|
result))
|
|
|
|
(export-always 'finder)
|
|
(defun finder (root &rest predicates)
|
|
"List files in ROOT that satisfy all PREDICATES.
|
|
Without PREDICATES, list all files."
|
|
(let ((*finder-include-directories* nil))
|
|
(apply #'walk root predicates)))
|
|
|
|
(defun match-date< (timestamp)
|
|
"Return a file predicate that matches on modification time #'< than timestamp."
|
|
(lambda (file)
|
|
(local-time:timestamp< (modification-date file) timestamp)))
|
|
|
|
(defun match-date> (timestamp)
|
|
"Return a file predicate that matches on modification time #'> than timestamp."
|
|
(lambda (file)
|
|
(local-time:timestamp> (modification-date file) timestamp)))
|