#!/usr/bin/newlisp

;; author:   Greg Slepak (taoeffect.com)
;; based on: http://github.com/russolsen/dejour/blob/master/bin/clj
;;
;; version history
;; 3.3 - nailgun + rlwrap fix + java args fix
;; 3.2 - fixed rlwrap bug
;; 3.1 - bugfixes
;; 3.0 - added full, awesome nailgun support
;; 2.0 - fixed a bug with -e arguments to clojure
;; 1.0 - initial release

(constant
	'CLOJURE_HOME     (or (env "CLOJURE_HOME") (string (env "HOME") "/.clojure"))
	'CLOJURE          (string CLOJURE_HOME "/clojure.jar")
	'CLOJURE_CONTRIB  (string CLOJURE_HOME "/clojure-contrib.jar")
	'NAILGUN          (list (string (env "NAILGUN_HOME") "/nailgun.jar") (string (env "CLOJURE_HOME") "/nailgun.jar"))
	'JLINE            (string (env "HOME") "/.m2/repository/jline/jline/0.9.94/jline-0.9.94.jar")
)

(define (die)
	(apply println (cons "ERROR: " $args))
	(exit 1)
)

(set
	'classpath       (list "." CLOJURE CLOJURE_CONTRIB JLINE)
	'java-args      '()
	'prog-args      '()
	'all-args        (2 (main-args))
	'clojure-main    "clojure.main"
	'jline-class     "jline.ConsoleRunner"
)

(while (setf arg (pop all-args))
	(if (or (= "-cp" arg) (= "-classpath" arg))
		(setf user-classpath (parse (pop all-args) ":"))
		(regex {^(-D|-X|-server|-client|-d32|-d64)} arg)
		(push arg java-args -1)
		(= arg "-J")
		(push (pop all-args) java-args -1)
		(= "-no-contrib" arg)
		(pop classpath (find CLOJURE_CONTRIB classpath))
		(= "-main" arg)
		(setf clojure-main (pop all-args))
		(= "-no-jline" arg)
		(begin (setf jline-class "") (pop classpath (find JLINE classpath)))
		(= "-rlwrap" arg)
		(setf rlwrap true)
		(= "-debug" arg)
		(setf debug-flag true)
		(= "-c" arg)
		(set-ref CLOJURE classpath (pop all-args))
		(= "-cc" arg)
		(set-ref CLOJURE_CONTRIB classpath (pop all-args))
		(= "-ng" arg)
		(begin (setf nailgun true rlwrap true) (push "-no-jline" all-args))
		(= "-nng" arg)
		(set 'no-nailgun true 'nailgun nil)
		; all else shall be treated as clojure args
		(= "--" arg)
		(set 'prog-args all-args 'all-args '())
		(begin (set 'prog-args all-args 'all-args '()) (push arg prog-args))
	)
)

(if user-classpath
	(extend classpath user-classpath)
	(when (env "CLASSPATH")
		(extend classpath (parse (env "CLASSPATH") ":"))
	)
)

(unless (null? (setf missing (clean file? classpath)))
	(println "WARN: missing from classpath: " missing)
)

(unless no-nailgun
	(if (setf idx (find true (map file? NAILGUN)))
		(begin
			(push (NAILGUN idx) classpath)
			(when (setf s (net-connect "localhost" 2113))
				(net-close s)
				(setf nailgun-up true rlwrap true)
			)
		)
		; if it was requested but couldn't be found, die
		(when nailgun (die "nailgun not found! Set NAILGUN_HOME and place nailgun.jar in it"))
	)
)

(if (and rlwrap (not (null? (setf rlwrap (exec "which rlwrap")))))
	(setf rlwrap (first rlwrap) jline-class "")
	(setf rlwrap "")
)

(unless nailgun-up
	(if (and nailgun (not debug-flag))
		(setf spawn-func (fn-macro (a)
			(spawn 'p (eval a))
			(println "waiting for nailgun...")
			(until (setf s (net-connect "localhost" 2113)) (sleep 100))
			(net-close s)
		))
		(setf spawn-func (fn ()))
	)
	(spawn-func (exit (! (format
		{%s %s java -DCLOJURE_HOME="%s" -classpath "%s" %s %s %s %s}
		(if debug-flag "echo" "")
		(if nailgun "" rlwrap)
		CLOJURE_HOME
		(join classpath ":")
		(join java-args " ")
		(if nailgun "" jline-class)
		(if nailgun "com.martiansoftware.nailgun.NGServer" clojure-main)
		(if nailgun "" (join (map (fn (arg) (string {"} arg {"})) prog-args) " "))
	))))
)

; nailgun guaranteed here
(exit (! (format
	{%s %s ng %s %s}
	(if debug-flag "echo" "")
	rlwrap
	clojure-main
	(join (map (fn (arg) (string {"} arg {"})) prog-args) " ")
)))