From fdaeb32b90b527fe2bc628073ac673a1d93e40c1 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Wed, 18 Nov 2020 11:44:46 +0100 Subject: [PATCH] ambrevar/shell: Add delete-empty-directory-upward. --- .local/share/common-lisp/source/ambrevar/shell.lisp | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/.local/share/common-lisp/source/ambrevar/shell.lisp b/.local/share/common-lisp/source/ambrevar/shell.lisp index 17b5da66..708d694d 100644 --- a/.local/share/common-lisp/source/ambrevar/shell.lisp +++ b/.local/share/common-lisp/source/ambrevar/shell.lisp @@ -83,6 +83,16 @@ Without PREDICATES, list all files." (let ((*finder-include-directories* nil)) (apply #'walk root predicates))) +(export-always 'delete-empty-directory-upward) +(defun delete-empty-directory-upward (directory) + "Delete directory and its parents until non-empty. +Return the first non-deleted directory." + (or (and (ignore-errors (uiop:delete-empty-directory directory)) + (delete-directory-upward + (uiop:pathname-parent-directory-pathname + (uiop:ensure-directory-pathname directory)))) + directory)) + (export-always 'make-directory) (defun make-directory (path) "Including parents."