changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/bin/skel.lisp

changeset 317: 1f14280be401
parent: 58aea6421176
child: c5956756f9e5
author: Richard Westhaver <ellis@rwest.io>
date: Wed, 08 May 2024 21:34:08 -0400
permissions: -rw-r--r--
description: repl tweaks
1 ;;; Code:
2 (uiop:define-package :bin/skel
3  (:use :cl :std :cli/clap :vc :sb-ext)
4  (:use-reexport :skel :log)
5  (:export :main))
6 
7 (in-package :bin/skel)
8 (in-readtable :shell)
9 
10 (defopt skc-help (print-help $cli))
11 (defopt skc-version (print-version $cli))
12 (defopt skc-log *log-level* (when $val (setq *log-level* :debug)))
13 
14 ;; TODO 2023-10-13: almost there
15 (defopt skc-cfg
16  (when $val
17  (init-user-skelrc (parse-file-opt $val))))
18 
19 (defcmd skc-config
20  (if $args
21  (describe (init-user-skelrc (parse-file-opt (car $args))))
22  (if (probe-file *user-skelrc*)
23  (describe (load-user-skelrc))
24  (describe (init-user-skelrc)))))
25 
26 (defcmd skc-edit
27  (let ((file (or (when $args (pop $args)) (find-skelfile #P"."))))
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  (inspect
53  (find-skelfile
54  (if $args (pathname (car $args))
55  #P".")
56  :load t)))
57 
58 (defcmd skc-id
59  (println (std:format-sxhash (obj/id:id (find-skelfile #P"." :load t)))))
60 
61 (defcmd skc-show
62  (println
63  (if $args
64  (let ((sel (trace! (pop $args))))
65  (std/string:string-case (sel :default (nyi!))
66  ("id" (std:format-sxhash (obj/id:id (find-skelfile #P"." :load t))))))
67  (find-skelfile #P"." :load t))))
68 
69 (defcmd skc-push
70  (case (sk-vc (find-skelfile #P"." :load t))
71  (:hg (run-hg-command "push" $args t))))
72 
73 (defcmd skc-pull
74  (case (sk-vc (find-skelfile #P"." :load t))
75  (:hg (run-hg-command "pull" (push "-u" $args) t))))
76 
77 (defcmd skc-status
78  (case (sk-vc (find-skelfile #P"." :load t))
79  (:hg (progn
80  (let ((proc (run-hg-command "status" nil :stream)))
81  (copy-stream (process-output proc) *standard-output*)
82  (finish-output))))
83  (t (progn
84  (let ((proc (run-git-command "status" nil :stream)))
85  (copy-stream (process-output proc) *standard-output*)
86  (finish-output))))))
87 
88 (defcmd skc-make
89  (if $args
90  (mapc (lambda (rule) (debug! (sk-run (sk-find-rule rule (find-skelfile #P"." :load t))))) $args)
91  (debug! (sk-run (aref (sk-rules (find-skelfile #P"." :load t)) 0)))))
92 
93 (defcmd skc-run
94  (if $args
95  (mapc (lambda (script) (debug! (sk-run (sk-find-script script (find-skelfile #P"." :load t))))) $args)
96  (required-argument :script)))
97 
98 (defcmd skc-shell
99  (if $args
100  (nyi!)
101  (let ((*no-exit* t))
102  (in-package :skel)
103  (use-package :std-user)
104  ;; (sb-ext:enable-debugger)
105  (require :sb-aclrepl)
106  (init-skel-vars)
107  (sb-impl::toplevel-repl nil))))
108 
109 (define-cli $cli
110  :name "skel"
111  :version "0.1.1"
112  :description "A hacker's project compiler and build tool."
113  :thunk skc-describe
114  :opts (make-opts
115  (:name "help" :global t :description "print this message"
116  :thunk skc-help)
117  (:name "version" :global t :description "print version"
118  :thunk skc-version)
119  (:name "level" :global t :description "set log level (debug,info,trace,warn)"
120  :thunk skc-log)
121  (:name "config" :global t :description "set a custom skel user config" :kind file
122  :thunk skc-cfg)
123  (:name "input" :global t :description "input source" :kind string)
124  (:name "output" :global t :description "output target" :kind string))
125  :cmds (make-cmds
126  (:name init
127  :description "initialize a skelfile in the current directory"
128  :opts (make-opts (:name "name" :description "project name" :kind string))
129  :thunk skc-init)
130  (:name describe
131  :description "describe a skelfile"
132  :thunk skc-describe)
133  (:name config
134  :opts (make-opts (:name "file" :description "skelrc file" :kind file))
135  :thunk skc-config)
136  (:name show
137  :description "show project slots"
138  :opts (make-opts
139  (:name "file" :description "path to skelfile" :kind file)
140  (:name "user" :description "print user configuration")
141  (:name "system" :description "print system configuration"))
142  :thunk skc-show)
143  (:name id
144  :description "print the project id"
145  :thunk skc-id)
146  (:name inspect
147  :description "inspect the project skelfile"
148  :opts (make-opts (:name "file" :description "path to skelfile" :kind file))
149  :thunk skc-inspect)
150  (:name make
151  :description "build project targets"
152  :opts (make-opts (:name "target" :description "target to build" :kind string))
153  :thunk skc-make)
154  (:name run
155  :description "run a script or command"
156  :thunk skc-run)
157  (:name status
158  :description "print the vc status"
159  :thunk skc-status)
160  (:name push
161  :description "push the current project upstream"
162  :thunk skc-push)
163  (:name pull
164  :description "pull the current project from remote"
165  :thunk skc-pull)
166  (:name clone
167  :description "clone a remote project")
168  (:name commit
169  :description "commit changes to the project vc")
170  (:name edit
171  :description "edit a project file in emacs."
172  :thunk skc-edit)
173  (:name shell
174  :description "open the sk-shell interpreter"
175  :thunk skc-shell)))
176 
177 (defun run ()
178  (let ((*log-level* :info))
179  (in-readtable :shell)
180  (with-cli (opts cmds) $cli
181  (load-skelrc)
182  ;; TODO 2024-01-01: need to parse out CMD opts from args slot - they still there
183  (do-opt (find-opt $cli "level"))
184  (do-cmd $cli)
185  (debug-opts $cli))))
186 
187 (defmain ()
188  (run)
189  (sb-ext:exit :code 0))