mirror of
https://github.com/roswell/roswell.git
synced 2026-09-10 07:16:17 -04:00
67 lines
2.7 KiB
Common Lisp
67 lines
2.7 KiB
Common Lisp
#!/bin/sh
|
|
#|-*- mode:lisp -*-|#
|
|
#|Creates a new ros script, optionally based on a template.
|
|
exec ros -Q -m roswell -L sbcl-bin -- $0 "$@"
|
|
|#
|
|
|
|
#-ros.util
|
|
(ros:include "util")
|
|
|
|
(defpackage :ros.sub.init
|
|
(:use :cl :ros))
|
|
|
|
(in-package :ros.sub.init)
|
|
|
|
(defun main (subcmd cmd &optional name &rest r)
|
|
(declare (ignore cmd))
|
|
(if (and (equal subcmd "main") name)
|
|
(let* ((date (get-universal-time))
|
|
(path
|
|
(or (probe-file (merge-pathnames (format nil "templates/~A/template.asd" name) (ros.util:homedir)))
|
|
(unless (find #\/ name)
|
|
(let ((dir (directory (merge-pathnames (format nil "templates/*/~A/template.asd" name) (ros.util:homedir)))))
|
|
(cond
|
|
((>= (length dir) 2)
|
|
(format *error-output* "ambiguous ~{~A~%~}" dir)
|
|
(quit -1))
|
|
((= 1 (length dir))
|
|
(setq name (format nil "~{~A~^/~}" (last (pathname-directory (first dir)) 2)))
|
|
(first dir))
|
|
(t nil)))))))
|
|
(when path
|
|
(load path)
|
|
(ql:quickload name :silent t)
|
|
(when *main*
|
|
(apply *main* name r)))
|
|
(setq path (make-pathname :defaults name :type "ros"))
|
|
(handler-case
|
|
(unless
|
|
(prog1
|
|
(with-open-file (out path
|
|
:direction :output
|
|
:if-exists nil
|
|
:if-does-not-exist :create)
|
|
(when out
|
|
(format out "~@{~A~%~}"
|
|
"#!/bin/sh"
|
|
"#|-*- mode:lisp -*-|#"
|
|
"#| <Put a one-line description here>"
|
|
"exec ros -Q -- $0 \"$@\"" "|#"
|
|
"(progn ;;init forms" " )" ""
|
|
(format nil "(defpackage :ros.script.~A.~A" name date)
|
|
" (:use :cl))"
|
|
(format nil "(in-package :ros.script.~A.~A)" name date)
|
|
""
|
|
"(defun main (&rest argv)"
|
|
" (declare (ignorable argv)))"
|
|
";;; vim: set ft=lisp lisp:")
|
|
(format t "~&Successfully generated: ~A~%" path)
|
|
t))
|
|
#+sbcl (sb-posix:chmod path #o700))
|
|
(format *error-output* "~&File already exists: ~A~%" path)
|
|
(quit -1))
|
|
(error (e)
|
|
(format *error-output* "~&~A~%" e)
|
|
(quit -1))))
|
|
()))
|