changeset 682: |
5e8b1855f866 |
parent: |
5f88b237ce29
|
child: |
2e7d93b892a5 |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Sat, 28 Sep 2024 16:42:55 -0400 |
permissions: |
-rw-r--r-- |
description: |
lisp fixes |
3 ;; TODO 2024-05-09: add shell configurables to rules - maybe at sk-command 4 ;; level. :INPUT :WAIT :OUTPUT 8 :vc :sb-ext :skel :log :cli/clap/util 9 :dat/sxp #+tools :skel/tools/viz) 10 (:import-from :cli/shell :*shell-input* :*shell-directory*) 11 (:use :cli/tools/sbcl)) 13 (in-package :bin/skel) 16 (defopt skc-help (print-help *cli*)) 17 (defopt skc-version (print-version *cli* t)) 18 (defopt skc-level *log-level* 19 (setq *log-level* (if *arg* (if (stringp *arg*) 20 (sb-int:keywordicate (string-upcase *arg*)) 24 (defopt skc-config (load-user-skelrc (or *arg* *user-skelrc*))) 27 (let ((file (or (when *args* (pop *args*)) (sk-path *skel-project*)))) 28 (cli/ed:run-emacsclient (namestring file)))) 31 (let ((file (when *args* (pop *args*))) 32 (name (when (> *argc* 1) (pop *args*)))) 33 ;; TODO: test, may need to be 34 ;; sequential for side-effect 39 (std:println (format nil "file already exists: ~A" (or file *default-skelfile*))) 40 (let ((f2 (read-line))) 44 (init-skelfile file name)))) 49 (find-skelfile (pathname (car *args*)) :load t) 50 (or *skel-project* *skel-user-config* *skel-system-config*)))) 54 (sb-ext:enable-debugger) 58 (if *args* (pathname (car *args*)) 65 (let ((stuff (loop for a in *args* 66 collect (sk-slot-case a)))) 67 (sk-view (if (= 1 (length stuff)) (car stuff) stuff))) 68 (sk-view (if (boundp '*skel-project*) *skel-project* 69 (if (boundp '*skel-user-config*) *skel-user-config* 70 (if (boundp '*skel-system-config*) *skel-system-config* 71 (skel-simple-error "skel config files not installed"))))))) 74 (println (std:format-sxhash (obj/id:id (find-skelfile #P"." :load t))))) 76 (defun call-with-args (action args) 77 (let* ((*default-pathname-defaults* *skel-path*)) 79 (sk-call *skel-project* action) 81 (sk-call *skel-project* (keywordicate (symbol-name action) '- (string-upcase x)))) 85 (call-with-args :compile *args*)) 87 (call-with-args :build *args*)) 89 (call-with-args :dist *args*)) 91 (call-with-args :install *args*)) 93 (call-with-args :pack *args*)) 95 (call-with-args :unpack *args*)) 97 (call-with-args :bundle *args*)) 99 (call-with-args :unbundle *args*)) 101 (call-with-args :clean *args*)) 103 (call-with-args :test *args*)) 105 (call-with-args :bench *args*)) 107 (call-with-args :save *args*)) 109 (defun sk-slot-case (sel) 110 (std/string:string-case ((string-left-trim ":" sel) :default (skel-simple-error "invalid slot")) 111 ("id" (std:format-sxhash (obj/id:id *skel-project*))) 112 ("name" (sk-name *skel-project*)) 113 ("author" (sk-author *skel-project*)) 114 ("version" (sk-version *skel-project*)) 115 ("description" (sk-description *skel-project*)) 116 ("tags" (sk-tags *skel-project*)) 117 ("license" (sk-license *skel-project*)) 118 ("vc" (sk-vc *skel-project*)) 119 ("components" (sk-components *skel-project*)) 120 ("scripts" (sk-scripts *skel-project*)) 121 ("rules" (sk-rules *skel-project*)) 122 ("phases" (hash-table-alist (sk-phases *skel-project*))) 123 ;; ("env" (sk-env *skel-project*)) 124 ("bind" (sk-bind *skel-project*)) 125 ("include" (sk-include *skel-project*)) 126 ("stash" (sk-stash *skel-project*)) 127 ("store" (sk-store *skel-project*)) 128 ("config" *skel-user-config*) 129 ("sys" *skel-system-config*) 130 ("cache" (sk-cache *skel-user-config*)))) 134 (mapc (lambda (x) (when-let ((ret (sk-slot-case x))) (println ret))) *args*) 135 (sk-print (if (boundp '*skel-project*) *skel-project* 136 (if (boundp '*skel-user-config*) *skel-user-config* 137 (if (boundp '*skel-system-config*) *skel-system-config* 138 (skel-simple-error "skel config files not installed"))))))) 141 (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t))) 142 (:git (run-git-command "push" *args* t)) 143 (:hg (run-hg-command "push" *args* t)) 144 (t (skel-simple-error "unknown VC type")))) 147 (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t))) 148 (:git (run-git-command "pull" *args* t)) 149 (:hg (run-hg-command "pull" (append '("-u") *args*) t)) 150 (t (skel-simple-error "unknown VC type")))) 153 (with-open-stream (proc (process-output (run-hg-command "status" nil :stream))) 154 (loop for x = (read-line proc nil) 159 (with-open-stream (proc (run-git-command "status" nil :stream)) 160 (loop for x = (read-line proc nil) 165 (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t))) 171 (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t))) 172 (:git (run-git-command "clone" *args* t)) 173 (:hg (run-hg-command "clone" *args* t)) 174 (t (skel-simple-error "unknown VC type")))) 177 (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t))) 178 (:git (run-git-command "commit" (append '("-m") *args*) t)) 179 (:hg (run-hg-command "commit" (when *args* (append '("-m") *args*)) t)) 180 (t (skel-simple-error "unknown VC type")))) 183 (let ((sk (find-skelfile #P"." :load t))) 184 (sb-ext:enable-debugger) 185 (log:debug! "cli args" *args*) 186 ;; (setq *no-exit* t) 188 (loop for a in *args* 190 (if-let ((rule (sk-find-rule a sk))) 192 ;; TODO 2024-08-23: restart condition here 193 (skel-simple-error "rule not found: ~A" a)))) 194 (debug! (sk-make sk (aref (sk-rules sk) 0)))))) 198 (mapc (lambda (script) 199 ;; first check if a script with the same name exists, else check for a rule definition 200 (if-let ((script (sk-find-script 201 (pathname-name script) 202 (find-skelfile #P"." :load t)))) 204 (call-with-args :run (list script)))) 206 (required-argument 'name))) 209 (let* ((sk (find-skelfile #P"." :load t)) 210 (vc (sk-vc-meta-kind (sk-vc sk)))) 211 (sb-ext:enable-debugger) 212 (with-open-stream (proc (process-output 213 (if-let ((cmd (pop *args*))) 215 (:hg (run-hg-command cmd *args* :stream)) 216 (:git (run-git-command cmd *args* :stream))) 217 (sb-ext:run-program (case vc (:hg *hg-program*) (:git *git-program*)) 220 (loop for x = (read-line proc nil) 225 (sb-ext:enable-debugger) 226 (trace! "starting skel shell") 228 (cli/clap::with-cli-handlers 230 (in-package :sk-user) 231 (use-package :cl-user) 232 (use-package :sb-ext) 233 (use-package :std-user) 235 (println "Welcome to SKEL") 236 (sb-impl::toplevel-repl nil)))) 242 (define-cli *skel-cli* 244 :version #.(format nil "0.1.1:~A" (read-line (sb-ext:process-output (vc:run-hg-command "id" '("-i") :stream)))) 246 :description "A hacker's project compiler." 248 :opts ((:name "help" :global t :description "print this message" 250 (:name "version" :global t :description "print version" 252 (:name "level" :global t :description "set log level (warn,info,debug,trace)" 254 (:name "config" :global t :description "set a custom skel user config" :kind file) 255 (:name "input" :global t :description "input source" :kind string) 256 (:name "output" :global t :description "output target" :kind string)) 258 :description "initialize a skelfile in the current directory" 259 :opts (:name "name" :description "project name" :kind string) 262 :description "make a new skel project" 263 :opts ((:name "name" :description "project name" :kind string)) 266 :description "describe a skelfile" 269 :description "show project slots" 270 :opts ((:name "file" :description "path to skelfile" :kind file)) 273 :description "version control" 275 :opts ((:name "root" :description "repository path" :kind directory))) 277 :description "print the project id" 280 :description "inspect the project skelfile" 281 :opts ((:name "file" :description "path to skelfile" :kind file)) 285 :description "view an object in a new GUI window" 288 :description "build project targets" 289 :opts ((:name "target" :description "target to build" :kind string)) 292 :description "run a script or command" 295 :description "compile source code" 298 :description "build programs and libraries" 301 :description "save a file" 304 :description "distribute build artifacts" 307 :description "install stuff" 310 :description "pack stuff" 313 :description "unpack stuff" 316 :description "bundle source code" 319 :description "unbundle source code" 322 :description "clean up the project" 325 :description "run tests" 328 :description "run benchmark" 331 :description "print the vc status" 334 :description "push the current project upstream" 337 :description "pull the current project from remote" 340 :description "clone a remote project" 343 :description "commit changes to the project vc" 345 :opts ((:name "message" :description "commit message" :kind string))) 347 :description "edit a project file in emacs." 350 :description "open the sk-shell interpreter" 353 (defmain start-skel () 354 (in-package :sk-user) 355 (let ((*log-level* :info)) 356 (in-readtable :shell) 357 (with-cli (*skel-cli* opts cmds) (cli:args) 359 (when-let ((project (find-skelfile #P"."))) 360 (let ((*default-pathname-defaults* (pathname (directory-namestring project)))) 361 (setq *skel-project* (load-skelfile project)) 362 (setq *skel-path* (sk-src *skel-project*)) 363 (setq cli/shell:*shell-directory* (sk-src *skel-project*)))) 366 (debug-opts *cli*))))