Megatest

Diff
Login

Differences From Artifact [36ef6b845c]:

To Artifact [d8f7bb6efe]:


258
259
260
261
262
263
264

265
266
267
268
269
270
271
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272







+







			"-archive"
			"-since"
			"-fields"
			"-recover-test" ;; run-id,test-id - used internally to recover a test stuck in RUNNING state
			"-sort"
			) 
		 (list  "-h" "-help" "--help"
			"-manual"
			"-version"
		        "-force"
		        "-xterm"
		        "-showkeys"
		        "-show-keys"
		        "-test-status"
			"-set-values"
401
402
403
404
405
406
407











408
409
410
411
412
413
414
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426







+
+
+
+
+
+
+
+
+
+
+








(if (or (args:get-arg "-h")
	(args:get-arg "-help")
	(args:get-arg "--help"))
    (begin
      (print help)
      (exit)))

(if (args:get-arg "-manual")
    (let* ((htmlviewercmd (or (configf:lookup *configdat* "setup" "htmlviewercmd")
			      (common:which '("firefox" "arora"))))
	   (install-home  (common:get-install-area))
	   (manual-html   (conc install-home "/share/docs/megatest_manual.html")))
      (if (and install-home
	       (file-exists? manual-html))
	  (system (conc "(" htmlviewercmd " " manual-html " ) &"))
	  (system (conc "(" htmlviewercmd " http://www.kiatoa.com/cgi-bin/fossils/megatest/doc/tip/docs/manual/megatest_manual.html ) &")))
      (exit)))

(if (args:get-arg "-start-dir")
    (if (file-exists? (args:get-arg "-start-dir"))
	(change-directory (args:get-arg "-start-dir"))
	(begin
	  (debug:print-error 0 *default-log-port* "non-existant start dir " (args:get-arg "-start-dir") " specified, exiting.")
	  (exit 1))))
1877
1878
1879
1880
1881
1882
1883

1884
1885
1886
1887
1888
1889
1890
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903







+







      (set! *didsomething* #t)))

;;======================================================================
;; Start a repl
;;======================================================================

;; fakeout readline
(include "readline-fix.scm")

(if (or (getenv "MT_RUNSCRIPT")
	(args:get-arg "-repl")
	(args:get-arg "-load"))
    (let* ((toppath (launch:setup))
	   (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: (args:get-arg "-local")) #f)))
      (if dbstruct
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1919
1920
1921
1922
1923
1924
1925

1926
1927
1928
1929
1930
1931
1932







-







	      (set! *db* dbstruct)
	      (set! *client-non-blocking-mode* #t)
	      (import extras) ;; might not be needed
	      ;; (import csi)
	      (import readline)
	      (import apropos)
	      ;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...
	      (include "readline-fix.scm")

	      (if *use-new-readline*
		  (begin
		    (install-history-file (get-environment-variable "HOME") ".megatest_history") ;;  [homedir] [filename] [nlines])
		    (current-input-port (make-readline-port "megatest> ")))
		  (begin
		    (gnu-history-install-file-manager