Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
(load "script-support")
(load "../asdf")
;; TODO:
;; - test for conditions
(defpackage :test-source-registry
(:use #:cl #:asdf))
(in-package :test-source-registry)
(defun getenv (x)
#+sbcl
(sb-posix:getenv x))
(defun setenv (x v)
#+sbcl
(sb-posix:putenv
(concatenate 'string x "=" v)))
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (gensym)))
,@body))
(defmacro with-env-var ((key value) &rest rest)
(with-gensyms (key-save)
`(let ((,key-save ,(getenv key)))
(unwind-protect
(progn
(setenv ,key ,value)
,@rest)
(progn
(setenv ,key ,key-save))))))
(defun make-temporary-directory ()
(let ((str (with-output-to-string (s)
(sb-ext:run-program "mktemp" '("-d") :search t :output s))))
(concatenate 'string
(string-trim '(#\newline) str) "/")))
(defvar *base-directory* (make-temporary-directory))
(defun home-directory (&optional (base *base-directory*))
(let ((s (namestring (user-homedir-pathname))))
(merge-pathnames (subseq s 1 (length s)) base)))
(defun system-directory (&optional (base *base-directory*))
(merge-pathnames "etc/" base))
(defun tmp-directory (&optional (base *base-directory*))
(merge-pathnames "tmp/" base))
(defun home-source-registry ()
(source-registry-under (merge-pathnames ".config/" (home-directory))))
(defun system-source-registry ()
(source-registry-under (system-directory)))
(defvar *asd-temp-path-1*
(merge-temp-under (tmp-directory))
(defvar *system-source-registry-config*
`(:source-registry
(:inherit-configuration)
(:tree ,*asd-temp-path-1*)))
(defvar *asd-temp-path-2*
(namestring (tmp-directory)))
(defvar *home-source-registry-config*
`(:source-registry
(:inhert-configuration)
(:directory ,(namestring (tmp-directory)))))
(defun write-registry-file (file contents)
(with-open-file (out file
:direction :output
:if-exists :supersede)
(with-standard-io-syntax
(format out "~S" contents))))
(defun write-system-source-registry-config ()
(write-registry-file (system-source-registry)
*system-source-registry-config*))
(defun write-home-source-registry-config ()
(write-registry-file (home-source-registry)
*home-source-registry-config*))
(defun merge-temp-under (path)
(namestring
(merge-pathnames
(let ((s (string-downcase
(prin1-to-string (gentemp)))))
(concatenate 'string s "/"))
path)))
;; test environment variable
;; test files
(cl-user::quit-on-error
...)