Build with roswell

.hgignore

@@ -1,8 +1,9 b''
 .*~
 .qlot
 .html
 .png
 .orig
 tests
 txt2web
 txt2web.tar.xz
+system-index.txt

Makefile

@@ -1,28 +1,32 b''
 
 BIN = txt2web
 DIST = $(BIN).tar.xz
+SCRIPT = $(BIN).ros
 
 all: $(BIN)
 
 dist: $(DIST)
 
 graphs: diagrams.png
 
-$(BIN): *.asd src/*.lisp src/*.ps strings/*.sexp
-	sbcl --load build.lisp -- $(BIN)
+$(BIN): bin/$(BIN)
+	ln -f $<
+
+bin/$(BIN): *.asd src/*.lisp src/*.ps strings/*.sexp bin/$(BIN).ros
+	ros build bin/$(SCRIPT)
 
 %.png: %.dot
 	dot $< -T png -o $@
 
 $(DIST): $(BIN) extras/*
 	tar cfvJ $@ $< extras
 
 clean:
-	rm -f $(BIN) $(DIST)
+	rm -f $(BIN) bin/$(BIN) $(DIST)
 
 clean-cache:
 	-rm -rf ~/.cache/common-lisp
 
 fresh: clean clean-cache all
 
 .PHONY: all graphs clean clean-cache fresh

src/main.lisp

@@ -1,158 +1,157 b''
 
 (in-package txt2web)
 
-(defvar *app-name* "")
+(defvar *app-name* "txt2web")
 
 (defun entry-point-no-args ()
   (setf *delivered* t)
   (entry-point uiop:*command-line-arguments*))
 
 (defun entry-point (args)
-  (setf *app-name* (uiop:argv0))
   (let ((*package* (find-package :txt2web)))
     (catch :terminate
       (let ((compiler (apply #'make-instance 'compiler (parse-opts args))))
         (write-compiled-file compiler))))
   (values))
 
 (defun parse-opts (args)
   (let ((mode :sources)
         (data (list :sources nil :target nil :js nil :css nil :body nil :compile nil :beautify nil)))
     (loop :for arg :in args
        :do (alexandria:switch (arg :test #'string=)
              ("-o" (setf mode :target))
              ("--js" (setf mode :js))
              ("--css" (setf mode :css))
              ("--body" (setf mode :body))
              ("-c" (setf (getf data :compile) t))
              ("--beautify" (setf (getf data :beautify) t))
              (t (push arg (getf data mode)))))
     (unless (< 0 (length (getf data :sources)))
       (report-error "There should be at least one source"))
     (unless (> 1 (length (getf data :target)))
       (report-error "There should be no more than one target"))
     (unless (> 1 (length (getf data :body)))
       (report-error "There should be no more than one body"))
     (unless (getf data :target)
       (setf (getf data :target)
             (let* ((sources (first (getf data :sources)))
                    (tokens (uiop:split-string sources :separator "."))
                    (target (format nil "~{~A~^.~}.html"
                                    (butlast tokens))))
               (list target))))
     (list :sources (getf data :sources)
           :target (first (getf data :target))
           :js (getf data :js)
           :css (getf data :css)
           :body (first (getf data :body))
           :compile (getf data :compile)
           :beautify (getf data :beautify))))
 
 (defun print-usage ()
   (lformat t :usage *app-name*))
 
 (defun parse-file (filename)
   (handler-case
       (p:parse 'txt2web-grammar
                (alexandria:read-file-into-string filename))
     (p:esrap-parse-error (e)
       (format t "~A~%" e)
       (uiop:quit 1))))
 
 (defun report-error (fmt &rest args)
   (format t "ERROR: ~A~%" (apply #'format nil fmt args))
   (print-usage)
   (throw :terminate nil))
 
 ;;; JS
 
 (defun minify-package (package-designator minify prefix)
   (setf (ps:ps-package-prefix package-designator) prefix)
   (if minify
       (ps:obfuscate-package package-designator)
       (ps:unobfuscate-package package-designator)))
 
 (defmethod js-sources ((compiler compiler))
   (let ((ps:*ps-print-pretty* (beautify compiler)))
     (cond ((beautify compiler)
            (minify-package "TXT2WEB.MAIN" nil "qsp_")
            (minify-package "TXT2WEB.API"  nil "qsp_api_")
            (minify-package "TXT2WEB.LIB"  nil "qsp_lib_"))
           (t
            (minify-package "TXT2WEB.MAIN" t   "_")
            (minify-package "TXT2WEB.API"  t   "a_")
            (minify-package "TXT2WEB.LIB"  t   "l_")))
     (format nil "~{~A~^~%~%~}" (mapcar #'ps:ps* (reverse (js compiler))))))
 
 ;;; CSS
 
 (defmethod css-sources ((compiler compiler))
   (format nil "~{~A~^~%~%~}" (css compiler)))
 
 ;;; HTML
 
 (defmethod html-sources ((compiler compiler))
   (let ((flute:*escape-html* nil)
         (body-template (body compiler))
         (js (js-sources compiler))
         (css (css-sources compiler)))
     (with-output-to-string (out)
       (write
        (flute:h
          (html
           (head
            (title "txt2web"))
           (body
            body-template
            (style css)
            (script js))))
        :stream out
        :pretty nil))))
 
 (defun filename-game (filename)
   (let ((filename (alexandria:lastcar (uiop:split-string filename :separator "/"))))
     (format nil "~{~A~^.~}" (butlast (uiop:split-string filename :separator ".")))))
 
 (defmethod initialize-instance ((compiler compiler) &key sources ((:js js-files)) ((:css css-files)) ((:body body-file)) compile &allow-other-keys)
   (call-next-method)
   (with-slots (body css js)
       compiler
     ;; Compile the game's JS
     (dolist (source sources)
       (let ((ps (parse-file source))
             (game-name (filename-game source)))
         (destructuring-bind (kw &rest locations)
             ps
           (unless (eq kw 'lib:game)
             (report-error "Internal error!"))
           (push 
            `(lib:game (,game-name) ,@locations)
            js))))
     ;; Does the user need us to do anything else
     (unless compile
       ;; Read in body
       (when body-file
         (setf body
               (alexandria:read-file-into-string body-file)))
       ;; Include js files
       (dolist (js-file js-files)
         (push (format nil "////// Included file ~A~%~A" js-file
                       (alexandria:read-file-into-string js-file))
               js))
       ;; Include css files
       (when css-files
         ;; User option overrides the default css
         (setf css nil)
         (dolist (css-file css-files)
           (push (format nil "////// Included file ~A~%~A" css-file
                         (alexandria:read-file-into-string css-file))
                 css))))))
 
 (defmethod write-compiled-file ((compiler compiler))
   (alexandria:write-string-into-file
    (if (compile-only compiler)
        ;; Just the JS
        (js-sources compiler)
        ;; All of it
        (html-sources compiler))
    (target compiler) :if-exists :supersede))