changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/bin/skel.lisp

changeset 356: aac665e2f5bf
parent: 254cca648492
child: a5a2d756ee2f
author: Richard Westhaver <ellis@rwest.io>
date: Tue, 21 May 2024 17:13:34 -0400
permissions: -rw-r--r--
description: stashed and revert some obj/color changes. added x/wayland feature splits, WITH-TCP-CLIENT and WITH-UDP-CLIENT impl (no tests)
1 ;;; Code:
2 
3 ;; TODO 2024-05-09: add shell configurables to rules - maybe at sk-command
4 ;; level. :INPUT :WAIT :OUTPUT
5 
6 (uiop:define-package :bin/skel
7  (:use :cl :std :cli/clap :vc :sb-ext)
8  (:import-from :cli/shell :*shell-input*)
9  (:use-reexport :skel :log)
10  (:export :main))
11 
12 (in-package :bin/skel)
13 (in-readtable :shell)
14 
15 (defopt skc-help (print-help $cli) $val)
16 (defopt skc-version (print-version $cli))
17 (defopt skc-level *log-level* (setq *log-level* (if $val (if (stringp $val)
18  (sb-int:keywordicate (string-upcase $val))
19  $val)
20  :info)))
21 
22 ;; TODO 2023-10-13: almost there
23 ;; (defopt skc-config
24 ;; (init-user-skelrc (when $val (parse-file-opt $val))))
25 
26 (defcmd skc-edit
27  (let ((file (or (when $args (pop $args)) (sk-path *skel-project*))))
28  (cli/ed:run-emacsclient (namestring file))))
29 
30 (defcmd skc-init
31  (let ((file (when $args (pop $args)))
32  (name (if (> $argc 1) (pop $args))))
33  (handler-bind
34  ((sb-ext:file-exists
35  #'(lambda (s)
36  (uiop:println (format nil "file already exists: ~A" (or file *default-skelfile*)))
37  (let ((f2 (read-line)))
38  (if (string= f2 "")
39  (error s)
40  (use-value f2 s))))))
41  (init-skelfile file name))))
42 
43 (defcmd skc-describe
44  (describe
45  (find-skelfile
46  (if $args (pathname (car $args))
47  #P".")
48  :load t)))
49 
50 (defcmd skc-inspect
51  (sb-ext:enable-debugger)
52  (setq *no-exit* t)
53  (inspect
54  (find-skelfile
55  (if $args (pathname (car $args))
56  #P".")
57  :load t)))
58 
59 (defcmd skc-id
60  (println (std:format-sxhash (obj/id:id (find-skelfile #P"." :load t)))))
61 
62 (defcmd skc-rev
63  (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
64  (:hg (progn
65  (let ((proc (run-hg-command "id" (list "-i") :stream)))
66  (copy-stream (process-output proc) *standard-output*)
67  (finish-output))))
68  (:git (progn
69  (let ((proc (run-git-command "rev-parse" (list "HEAD") :stream)))
70  (copy-stream (process-output proc) *standard-output*)
71  (finish-output))))
72  (t (skel-error "unknown VC type"))))
73 
74 (defun sk-slot-case (sel)
75  (std/string:string-case (sel :default (skel-error "invalid slot"))
76  (":id" (std:format-sxhash (obj/id:id *skel-project*)))
77  (":name" (sk-name *skel-project*))
78  (":author" (sk-author *skel-project*))
79  (":version" (sk-version *skel-project*))
80  (":description" (sk-description *skel-project*))
81  (":tags" (sk-tags *skel-project*))
82  (":license" (sk-license *skel-project*))
83  (":vc" (sk-vc *skel-project*))
84  (":docs" (sk-docs *skel-project*))
85  (":scripts" (sk-scripts *skel-project*))
86  (":snippets" (sk-snippets *skel-project*))
87  (":rules" (sk-rules *skel-project*))
88  (":env" (sk-env *skel-project*))
89  (":vars" (sk-vars *skel-project*))
90  (":imports" (sk-imports *skel-project*))
91  (":stash" (sk-stash *skel-project*))
92  (":store" (sk-store *skel-project*))
93  (":config" (describe *skel-user-config*))
94  (":sys" (describe *skel-system-config*))
95  (":cache" (sk-cache *skel-user-config*))))
96 
97 (defcmd skc-show
98  (if $args
99  (mapc (lambda (x) (when-let ((ret (sk-slot-case x))) (println ret))) $args)
100  (describe (if (boundp '*skel-project*) *skel-project*
101  (if (boundp '*skel-user-config*) *skel-user-config*
102  (if (boundp '*skel-system-config*) *skel-system-config*
103  (skel-error "skel config files not installed")))))))
104 
105 (defcmd skc-push
106  (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
107  (:git (run-git-command "push" $args t))
108  (:hg (run-hg-command "push" $args t))
109  (t (skel-error "unknown VC type"))))
110 
111 (defcmd skc-pull
112  (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
113  (:git (run-git-command "pull" $args t))
114  (:hg (run-hg-command "pull" (push "-u" $args) t))
115  (t (skel-error "unknown VC type"))))
116 
117 (defun hg-status ()
118  (let ((proc (run-hg-command "status" nil :stream)))
119  (copy-stream (process-output proc) *standard-output*)
120  (finish-output)))
121 
122 (defun git-status ()
123  (let ((proc (run-git-command "status" nil :stream)))
124  (copy-stream (process-output proc) *standard-output*)
125  (finish-output)))
126 
127 (defcmd skc-status
128  (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
129  (:git (git-status))
130  (:hg (hg-status))
131  (t (hg-status))))
132 
133 (defcmd skc-clone
134  (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
135  (:git (run-git-command "clone" $args t))
136  (:hg (run-hg-command "clone" $args t))
137  (t (skel-error "unknown VC type"))))
138 
139 (defcmd skc-commit
140  ;; (debug! $optc $argc)
141  (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
142  (:git (run-git-command "commit" $args t))
143  (:hg (run-hg-command "commit" $args t))
144  (t (skel-error "unknown VC type"))))
145 
146 (defcmd skc-make
147  (let ((sk (find-skelfile #P"." :load t)))
148  (sb-ext:enable-debugger)
149  (setq *no-exit* t)
150  (if $args
151  (loop for a in $args
152  do (debug!
153  (when-let ((rule (sk-find-rule a sk)))
154  (sk-make sk rule))))
155  (debug! (sk-make sk (aref (sk-rules sk) 0))))))
156 
157 (defcmd skc-run
158  (if $args
159  (mapc (lambda (script)
160  (debug!
161  (sk-run
162  (sk-find-script
163  (pathname-name script)
164  (find-skelfile #P"." :load t))))) $args)
165  (required-argument :script)))
166 
167 (defcmd skc-shell
168  (sb-ext:enable-debugger)
169  (trace! "starting skel shell")
170  (setq *no-exit* t)
171  (cli/clap::with-cli-handlers
172  (progn
173  (in-package :sk-user)
174  (use-package :cl-user)
175  (use-package :sb-ext)
176  (use-package :std-user)
177  (init-skel-vars)
178  (println "Welcome to SKEL")
179  (sb-impl::toplevel-repl nil))))
180 
181 (define-cli $cli
182  :name "skel"
183  :version "0.1.1"
184  :description "A hacker's project compiler and build tool."
185  :thunk skc-show
186  :opts (make-opts
187  (:name "help" :global t :description "print this message"
188  :thunk skc-help)
189  (:name "version" :global t :description "print version"
190  :thunk skc-version)
191  (:name "level" :global t :description "set log level (warn,info,debug,trace)"
192  :thunk skc-level)
193  (:name "config" :global t :description "set a custom skel user config" :kind file)
194  (:name "input" :global t :description "input source" :kind string)
195  (:name "output" :global t :description "output target" :kind string))
196  :cmds (make-cmds
197  (:name init
198  :description "initialize a skelfile in the current directory"
199  :opts (make-opts (:name "name" :description "project name" :kind string))
200  :thunk skc-init)
201  (:name describe
202  :description "describe a skelfile"
203  :thunk skc-describe)
204  (:name show
205  :description "show project slots"
206  :opts (make-opts
207  (:name "file" :description "path to skelfile" :kind file)
208  (:name "user" :description "print user configuration")
209  (:name "system" :description "print system configuration"))
210  :thunk skc-show)
211  (:name id
212  :description "print the project id"
213  :thunk skc-id)
214  (:name rev
215  :description "print the current vc revision id"
216  :thunk skc-rev)
217  (:name inspect
218  :description "inspect the project skelfile"
219  :opts (make-opts (:name "file" :description "path to skelfile" :kind file))
220  :thunk skc-inspect)
221  (:name make
222  :description "build project targets"
223  :opts (make-opts (:name "target" :description "target to build" :kind string))
224  :thunk skc-make)
225  (:name run
226  :description "run a script or command"
227  :thunk skc-run)
228  (:name status
229  :description "print the vc status"
230  :thunk skc-status)
231  (:name push
232  :description "push the current project upstream"
233  :thunk skc-push)
234  (:name pull
235  :description "pull the current project from remote"
236  :thunk skc-pull)
237  (:name clone
238  :description "clone a remote project"
239  :thunk skc-clone)
240  (:name commit
241  :description "commit changes to the project vc"
242  :thunk skc-commit)
243  (:name edit
244  :description "edit a project file in emacs."
245  :thunk skc-edit)
246  (:name shell
247  :description "open the sk-shell interpreter"
248  :thunk skc-shell)))
249 
250 (defpackage :sk-user
251  (:use :cl :std :skel))
252 
253 (defmain ()
254  (in-package :sk-user)
255  (let ((*log-level* :info))
256  (in-readtable :shell)
257  (with-cli (opts cmds) $cli
258  (load-skelrc)
259  (when-let ((project (find-skelfile #P".")))
260  (setq *skel-project* (load-skelfile project)))
261  (do-cmd $cli)
262  (debug-opts $cli))))