mirror of https://codeberg.org/cage/tinmop/
- added 'get-resource-dir' and 'get-data-dir'.
This commit is contained in:
parent
f1f25a66ec
commit
94e50430a8
|
@ -466,7 +466,8 @@
|
|||
:create-empty-in-home
|
||||
:get-config-file
|
||||
:get-sys-config-file
|
||||
:get-data-file))
|
||||
:get-data-file
|
||||
:get-data-dir))
|
||||
|
||||
(defpackage :zip-info
|
||||
(:use
|
||||
|
|
|
@ -63,6 +63,26 @@
|
|||
(fs:create-file home-file :skip-if-exists t)
|
||||
(get-resource-file system-dir home-dir path))))))))
|
||||
|
||||
(defun get-resource-dir (system-dir home-dir path)
|
||||
(let ((system-dir (fs:cat-parent-dir system-dir path))
|
||||
(home-dir (fs:cat-parent-dir home-dir path)))
|
||||
(cond
|
||||
((fs:dirp home-dir)
|
||||
home-dir)
|
||||
((fs:dirp system-dir)
|
||||
system-dir)
|
||||
(t
|
||||
(let ((msg (_ "Cannot find ~s in either ~s or ~s.")))
|
||||
(restart-case
|
||||
(error (format nil msg path system-dir home-dir))
|
||||
(return-home-dirname ()
|
||||
home-dir)
|
||||
(return-system-dirname ()
|
||||
system-dir)
|
||||
(create-empty-in-home ()
|
||||
(fs:make-directory home-dir)
|
||||
(get-resource-dir system-dir home-dir path))))))))
|
||||
|
||||
(defun get-config-file (path)
|
||||
(get-resource-file +sys-conf-dir+ (home-confdir) path))
|
||||
|
||||
|
@ -75,3 +95,6 @@
|
|||
|
||||
(defun get-data-file (path)
|
||||
(get-resource-file +sys-data-dir+ (home-datadir) path))
|
||||
|
||||
(defun get-data-dir (path)
|
||||
(get-resource-dir +sys-data-dir+ (home-datadir) path))
|
||||
|
|
Loading…
Reference in New Issue