Megatest

;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

(declare (uses commonmod))
(declare (uses debugprint))
(declare (uses mtargs))
(declare (uses mtver))
(declare (uses rmtmod))
(declare (uses tree))

(module dashboard

	srfi-4
	srfi-14
	srfi-18
	)

(import (prefix mtargs args:)
	;; gutils
	commonmod
	debugprint
	mtver
	rmtmod
	tree
	)

(define help (conc 
	      "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
  version " megatest-version "

    (begin
      (print help)
      (exit)))

(if (args:get-arg "-start-dir")
    (if (directory-exists? (args:get-arg "-start-dir"))
        (let ((fullpath (common:real-path (args:get-arg "-start-dir"))))
          (setenv "PWD" fullpath)
          (set-environment-variable! "PWD" fullpath)
          (change-directory fullpath))
	(begin
	  (debug:print-error 0 *default-log-port* "non-existant start dir " (args:get-arg "-start-dir") " specified, exiting.")
 	  (exit 1))))


(define (get-debugcontrolf)
  (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
    (if (common:file-exists? debugcontrolf)
	debugcontrolf
	#f)))

(define (dashboard-main)
  (iup:show
   (iup:dialog
    (iup:vbox
     (iup:button "Pushme"))))
  (iup:main-loop))

(define (main)
  (if (args:get-arg "-repl")
      (repl)
      (dashboard-main)))

)