cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-01-30 04:14:47 +01:00
Code Issues

- fixed regression in 'text-utils:parent-dir-path'.

Browse Source
This commit is contained in:
cage 2022-09-10 14:04:56 +02:00
parent 76a9a3aaff
commit 90c4af648b
1 changed files with 13 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/filesystem-utils.lisp
View File

@ -281,23 +281,26 @@
(and (> (length registers) 0)
(elt registers 0))))
(defun parent-dir-path (path)
(let ((splitted (remove-if #'(lambda (a) (string= "" a))
(defun parent-dir-path (path &key (normalize-results nil))
(let ((splitted (remove-if #'text-utils:string-empty-p
(split-path-elements path))))
(cond
((> (length splitted) 1)
(let ((res (if (string= (string (elt path 0)) *directory-sep*)
(concatenate 'string *directory-sep* (first splitted))
(first splitted))))
(loop for i in (subseq splitted 1 (1- (length splitted))) do
(setf res (concatenate 'string res *directory-sep* i)))
(setf res (concatenate 'string res *directory-sep*))
res))
(let ((path (text-utils:join-with-strings (misc:safe-all-but-last-elt splitted)
*directory-sep*)))
(setf path (text-utils:strcat path *directory-sep*))
(when (string= (first splitted) *directory-sep*)
(setf path (subseq path 1)))
(if normalize-results
(normalize-path path)
path)))
((or (= (length splitted) 1)
(null splitted))
*directory-sep*)
(t
path))))
(if normalize-results
(normalize-path path)
path)))))
(defun append-file-to-path (dir filename)
(let ((actual-dir (if (cl-ppcre:scan (concatenate 'string *directory-sep* "$")