Skip to content

Commit 3c861b3

Browse files
jcs090218jcs090218
committed
wip dist
1 parent dd14fee commit 3c861b3

17 files changed

+343
-133
lines changed

‎cmds/core/build.lisp

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -31,8 +31,7 @@
3131

3232
(defun handler (cmd)
3333
"Handler for `build' command."
34-
;;(format t "~A" clingon:command-arguments)
35-
(qob-cli:call-script "core/build"))
34+
(qob-cli:call-script "core/build" cmd))
3635

3736
(defun command ()
3837
"The `build' command."

‎cmds/core/dists.lisp

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -19,8 +19,7 @@
1919

2020
(defun handler (cmd)
2121
"Handler for `dists' command."
22-
(declare (ignore cmd))
23-
(qob-cli:call-script "core/dists"))
22+
(qob-cli:call-script "core/dists" cmd))
2423

2524
(defun command ()
2625
"The `dists' command."

‎cmds/core/install.lisp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@
2020
(defun handler (cmd)
2121
"Handler for `install' command."
2222
(declare (ignore cmd))
23-
(qob-cli:call-script "core/install"))
23+
(qob-cli:call-script "core/install" cmd))
2424

2525
(defun command ()
2626
"The `install' command."

‎cmds/core/list.lisp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@
2020
(defun handler (cmd)
2121
"Handler for `list' command."
2222
(declare (ignore cmd))
23-
(qob-cli:call-script "core/list"))
23+
(qob-cli:call-script "core/list" cmd))
2424

2525
(defun command ()
2626
"The `list' command."

‎cmds/qob.lisp

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,8 @@
1717
:description "set verbosity from 0 to 5"
1818
:short-name #\v
1919
:long-name "verbose"
20+
:initial-value 3
21+
:env-vars '("QOB_VERBOSE")
2022
:key :verbose)))
2123

2224
(defun handler (cmd)

‎lisp/_no_ql.lisp

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
;;; _no_ql.el --- Functions overwrite when no Quicklisp is loaded
2+
;;; Commentary:
3+
;;; Code:
4+
5+
(defun qob-quicklisp-install (dir)
6+
"For `_ql.lisp'."
7+
(declare (ignore dir)))
8+
9+
;;; End of _no_ql.lisp

‎lisp/_prepare.lisp

Lines changed: 145 additions & 97 deletions
Original file line numberDiff line numberDiff line change
@@ -2,27 +2,93 @@
22
;;; Commentary: Prepare to setup Qob environment for sandboxing
33
;;; Code:
44

5-
65
;;
76
;;; Includes
87

98
(require "asdf")
109

10+
;;
11+
;;; Verbose
12+
13+
(defun qob-princ (stream fmt &rest args)
14+
"Root print function with STREAM.
15+
16+
The argument STREAM is used to decide weather the stream should be standard
17+
output or standard error.
18+
19+
The arguments FMT and ARGS are used to form the output message."
20+
(let ((object (apply #'format nil fmt args))
21+
(stream (case stream
22+
(stdout *standard-output*)
23+
(stderr *error-output*)
24+
(t t))))
25+
(princ object stream)
26+
(force-output stream)
27+
))
28+
29+
(defun qob-print (msg &rest args)
30+
"Standard output print MSG and ARGS."
31+
(apply #'qob-princ 'stdout msg args))
32+
33+
(defun qob-println (msg &rest args)
34+
"Like function `qob-print' but with newline at the end."
35+
(apply #'qob-print msg args)
36+
(qob-print "~%"))
37+
38+
(defun qob-msg (msg &rest args)
39+
"Standard error print MSG and ARGS."
40+
(apply #'qob-princ 'stderr msg args)
41+
(qob-princ 'stderr "~%"))
42+
43+
(defun qob-trace (msg &rest args)
44+
""
45+
;; TODO: ..
46+
(apply #'qob-msg msg args))
47+
48+
(defun qob-debug (msg &rest args)
49+
""
50+
;; TODO: ..
51+
(apply #'qob-msg msg args)
52+
)
53+
54+
(defun qob-info (msg &rest args)
55+
""
56+
;; TODO: ..
57+
(apply #'qob-msg msg args)
58+
)
59+
60+
(defun qob-warn (msg &rest args)
61+
""
62+
;; TODO: ..
63+
(apply #'qob-msg msg args)
64+
)
65+
66+
(defun qob-error (msg &rest args)
67+
""
68+
;; TODO: ..
69+
(apply #'qob-msg msg args)
70+
)
71+
1172
;;
1273
;;; Environment
1374

14-
(defvar qob-dot-global (uiop:getenv "QOB_DOT_GLOBAL")
15-
"Return the global .qob directory.")
75+
(defvar qob-lisp (uiop:getenv "QOB_LISP")
76+
"Return the current lisp implementation.")
1677

17-
(defvar qob-dot-local (uiop:getenv "QOB_DOT_LOCAL")
18-
"Return the local .qob directory.")
78+
(defvar qob-dot (uiop:getenv "QOB_DOT")
79+
"Return the current .qob directory.")
1980

20-
(defvar qob-temp-filename (uiop:merge-pathnames* qob-dot-global "TMP")
81+
(defvar qob-temp-filename (uiop:getenv "QOB_TEMP_FILE")
2182
"Return the temp buffer filename.")
2283

23-
(defun qob-dot ()
24-
"Return the current .qob directory."
25-
(if (qob-global-p) qob-dot-global qob-dot-local))
84+
(defvar qob-lisp-root (uiop:getenv "QOB_LISP_ROOT")
85+
"Source `lisp' directory; should always end with slash.")
86+
87+
(defvar qob-user-init (uiop:getenv "QOB_USER_INIT")
88+
"Return the user init file.")
89+
90+
(defvar qob-quicklisp-installed-p (uiop:getenv "QOB_QUICKLISP_INSTALLED")
91+
"Return non-nil if Quicklisp is already installed.")
2692

2793
;;
2894
;;; Flags
@@ -37,6 +103,13 @@
37103
;; TODO: ..
38104
t)
39105

106+
;;
107+
;;; Elisp Layer
108+
109+
(defun el-memq (elt list)
110+
"Mimic `memq' function."
111+
(member elt list :test #'eq))
112+
40113
;;
41114
;;; Utils
42115

@@ -45,104 +118,79 @@
45118
(let ((len (if (numberp len-or-list) len-or-list (length len-or-list))))
46119
(if (<= len 1) form-1 form-2)))
47120

48-
(defun qob-import (url)
49-
"Load and eval the script from a URL."
50-
(let ((bytes (dex:get url)))
51-
(with-open-file (out qob-temp-filename
52-
:direction :output
53-
:if-exists :supersede
54-
:if-does-not-exist :create
55-
:element-type 'unsigned-byte)
56-
(write-sequence bytes out))))
121+
(defvar qob-loading-file-p nil
122+
"This became t; if we are loading script from another file and not expecting
123+
the `qob-start' execution.")
124+
125+
(defun qob-script (script)
126+
"Return full SCRIPT filename."
127+
(concatenate 'string qob-lisp-root script ".lisp"))
128+
129+
(defun qob-call (script)
130+
"Call another qob SCRIPT."
131+
(let ((script-file (qob-script script)))
132+
(when (uiop:file-exists-p script-file)
133+
(load script-file)
134+
(qob-error "Script missing %s" script-file))))
135+
136+
(defun qob-load (script)
137+
"Load another eask SCRIPT; so we can reuse functions across all scripts."
138+
(let ((qob-loading-file-p t)) (qob-call script)))
57139

58140
;;
59141
;;; Package
60142

61-
(defun qob-quicklisp-installed-p ()
62-
"Return non-nil if Quicklisp is already installed."
63-
(uiop:file-exists-p (concatenate 'string (qob-dot) "quicklisp.lisp")))
64-
65143
(defun qob-install-quicklisp ()
66144
"Install Quicklisp if not installed."
67-
(alexandria:when-let ((ql (qob-quicklisp-installed-p)))
68-
(load ql)
69-
(quicklisp-quickstart:install)
70-
(ql:add-to-init-file)))
145+
(let* ((quicklisp-dir (uiop:merge-pathnames* "quicklisp/" qob-dot))
146+
(quicklisp-init (uiop:merge-pathnames* "setup.lisp" quicklisp-dir)))
147+
(unless qob-quicklisp-installed-p
148+
(qob-quicklisp-install quicklisp-dir))
149+
(when (probe-file quicklisp-init)
150+
(load quicklisp-init))))
71151

72152
;;
73-
;;; Verbose
74-
75-
(defun qob-princ (stream fmt &rest args)
76-
"Root print function with STREAM.
77-
78-
The argument STREAM is used to decide weather the stream should be standard
79-
output or standard error.
80-
81-
The arguments FMT and ARGS are used to form the output message."
82-
(apply #'format (case stream
83-
(`stdout *standard-output*)
84-
(`stderr *error-output*)
85-
(t t))
86-
fmt args))
87-
88-
(defun qob-print (msg &rest args)
89-
"Standard output print MSG and ARGS."
90-
(apply #'qob-princ 'stdout msg args))
91-
92-
(defun qob-println (msg &rest args)
93-
"Like function `qob-print' but with newline at the end."
94-
(apply #'qob-print msg args)
95-
(terpri))
96-
97-
(defun qob-msg (msg &rest args)
98-
"Standard error print MSG and ARGS."
99-
(apply #'qob-princ 'stderr msg args)
100-
(terpri))
153+
;;; Core
101154

102-
(defun qob-info (msg &rest args)
103-
""
104-
(qob-princ )
155+
(defun qob-asd-test-files ()
156+
"Return a list of ASD test files."
157+
(directory "*-test*.asd"))
158+
159+
(defun qob-asd-files (&optional with-test)
160+
"Return a list of ASD files.
161+
162+
If optional argument WITH-TEST is non-nil; include test ASD files as well."
163+
(uiop:if-let ((files (directory "*.asd"))
164+
(_ (not with-test))
165+
(tests (qob-asd-test-files)))
166+
(remove-if (lambda (filename) (el-memq filename tests)) files)
167+
files))
168+
169+
(defun qob-load-system (filename)
170+
"Load the system from ASD's FILENAME; and return the registered name."
171+
(let ((dir (uiop:pathname-parent-directory-pathname filename))
172+
(file (pathname-name filename)))
173+
(push dir asdf:*central-registry*)
174+
(asdf:load-system file)
175+
file)) ; registered name
176+
177+
(defun qob-find-system (name)
178+
"Return a system of given NAME."
179+
(asdf/system-registry:registered-system name))
180+
181+
(defun qob-setup ()
182+
"Setup the system."
183+
(qob-install-quicklisp)
184+
;; (let ((files (qob-asd-files t)))
185+
;; (mapc (lambda (file)
186+
;; (qob-load-system file)
187+
;; (qob-info "Load ASD file ~A" file))
188+
;; files))
105189
)
106190

107191
;;
108-
;;; Core
192+
;;; Externals
109193

110-
(defmacro qob-start (&rest body)
111-
"Execute BODY with workspace setup."
112-
`(progn
113-
(push (uiop:getcwd) asdf:*central-registry*)
114-
,@body))
115-
116-
;; (defun qob-setup ()
117-
;; "Setup the system."
118-
;; (let ((files (asd-files t)))
119-
;; (mapc (lambda (file)
120-
;; (load-system file)
121-
;; (-info "Load ASD file ~A" file))
122-
;; files)))
123-
;;
124-
;; (defun qob-load-system (filename)
125-
;; "Load the system from ASD's FILENAME; and return the registered name."
126-
;; (let ((dir (uiop:pathname-parent-directory-pathname filename))
127-
;; (file (pathname-name filename)))
128-
;; (push dir asdf:*central-registry*)
129-
;; (asdf:load-system file)
130-
;; file)) ; registered name
131-
;;
132-
;; (defun qob-find-system (name)
133-
;; "Return a system of given NAME."
134-
;; (asdf/system-registry:registered-system name))
135-
;;
136-
;; (defun qob-asd-files (&optional with-test)
137-
;; "Return a list of ASD files.
138-
;;
139-
;; If optional argument WITH-TEST is non-nil; include test ASD files as well."
140-
;; (uiop:if-let ((files (directory "*.asd"))
141-
;; (_ (not with-test))
142-
;; (tests (asd-test-files)))
143-
;; (remove-if (lambda (filename) (el-lib:el-memq filename tests)) files)
144-
;; files))
145-
;;
146-
;; (defun qob-asd-test-files ()
147-
;; "Return a list of ASD test files."
148-
;; (directory "*-test*.asd"))
194+
;;(qob-load "extern/alexandria")
195+
196+
;;; End of _prepare.lisp

‎lisp/_ql.lisp

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
;;; _ql.el --- Functions overwrite when Quicklisp is loaded
2+
;;; Commentary:
3+
;;; Code:
4+
5+
(defun qob-quicklisp-install (dir)
6+
"For `_no_ql.lisp'."
7+
(quicklisp-quickstart:install :path dir))
8+
9+
;;; End of _ql.lisp
10+

‎lisp/core/build.lisp

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
;;;; lisp/core/build.lisp --- Build executable
1+
;;;; core/build.lisp --- Build executable
22

33
;;; Commentary
44
;;
@@ -24,3 +24,5 @@
2424
;; TODO: Change build path.
2525
(qob-setup)
2626
(asdf:operate :build-op name)))
27+
28+
;;; End of core/build.lisp

‎lisp/core/dists.lisp

Lines changed: 11 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
;;;; lisp/core/dists.lisp --- Build executable
1+
;;;; core/dists.lisp --- Build executable
22

33
;;; Commentary
44
;;
@@ -9,15 +9,18 @@
99

1010
;;; Code
1111

12+
(qob-setup)
13+
1214
(defun qob-dists--print (dists)
1315
"Print list of dists."
1416
(dolist (dist dists)
1517
(qob-println "~A" dist)))
1618

17-
(qob-start
18-
(let ((dists (ql-dist:all-dists)))
19-
(qob-info "Available dists:")
20-
(qob-msg "")
21-
(qob-dists--print dists)
22-
(qob-info "(Total of ~A dist~A available)" (length dists)
23-
(qob--sinr dists))))
19+
(let ((dists (ql-dist:all-dists)))
20+
(qob-info "Available dists:")
21+
(qob-msg "")
22+
(qob-dists--print dists)
23+
(qob-info "(Total of ~A dist~A available)" (length dists)
24+
(qob--sinr dists "" "s")))
25+
26+
;;; End of core/dists.lisp

0 commit comments

Comments
 (0)