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

ambrevar: Move and update old match- functions to file.lisp.

master
Pierre Neidhardt 2021-01-20 12:37:58 +01:00
parent ee2c3268e1
commit a8b9fa81f2
2 changed files with 35 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -226,6 +226,29 @@ Basename includes the extension. Useful for `finder'."
(str:contains? name (basename file)))
(cons name more-names))))
;; TODO: Better control to filter in/out directories?
;; (export-always 'match-directory)
;; (defun match-directory (&key (empty? t) (non-empty? t) (files? t))
;; "Return a predicate that matches on directories.
;; If target is a file, return FILES?.
;; Useful for `walk'."
;; (lambda (directory)
;; (if (uiop:directory-exists-p directory)
;; (let ((files-or-dirs? (or (uiop:directory-files directory)
;; (uiop:subdirectories directory))))
;; (or (and empty?
;; (not files-or-dirs?))
;; (and non-empty?
;; files-or-dirs?)))
;; files?)))
(export-always 'match-executable)
(defun match-executable ()
(lambda (file)
(intersection
(permissions file)
'(:user-exec :group-exec :other-exec))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defparameter %magic-cookie-mime nil
"Internal storage for `magic-cookie-mime'.")
@ -285,6 +308,18 @@ See `%description'."
(let ((*finder-constructor* #'file+mime))
(apply #'finder root predicates)))
(export-always 'match-elf-binary)
(defun match-elf-binary ()
(lambda (file)
(and (slot-boundp file 'mime-type)
(string= "application/x-executable" (mime-type file)))))
(export-always 'match-elf-library)
(defun match-elf-library ()
(lambda (file)
(and (slot-boundp file 'mime-type)
(ppcre:scan "application/x-sharedlib" (first (mime-type file))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass* mediafile (file+mime) ; REVIEW: Include MIME?

32
.local/share/common-lisp/source/ambrevar/shell.lisp
View File

@ -30,38 +30,6 @@
(delete-if #'sera:resolve-executable (cons program more-programs))))
(error "Missing programs: ~{~a~,^, ~}" missing-programs)))
(export-always 'match-directory)
(defun match-directory (&key (empty? t) (non-empty? t) (files? t))
"Return a predicate that matches on directories.
If target is a file, return FILES?.
Useful for `walk'."
(lambda (directory)
(if (uiop:directory-exists-p directory)
(let ((files-or-dirs? (or (uiop:directory-files directory)
(uiop:subdirectories directory))))
(or (and empty?
(not files-or-dirs?))
(and non-empty?
files-or-dirs?)))
files?)))
(export-always 'match-executable)
(defun match-executable ()
(lambda (file)
(intersection
(osicat:file-permissions file)
'(:user-exec :group-exec :other-exec))))
(export-always 'match-elf-binary)
(defun match-elf-binary ()
(lambda (file)
(string= "application/x-executable" (file-mime-type file))))
(export-always 'match-elf-library)
(defun match-elf-library ()
(lambda (file)
(ppcre:scan "application/x-sharedlib" (first (file-mime-type file)))))
(export-always 'delete-empty-directory-upward)
(defun delete-empty-directory-upward (directory)
"Delete directory and its parents until non-empty.