| ︙ | | | ︙ | |
258
259
260
261
262
263
264
265
266
267
268
269
270
271
|
"-archive"
"-since"
"-fields"
"-recover-test" ;; run-id,test-id - used internally to recover a test stuck in RUNNING state
"-sort"
)
(list "-h" "-help" "--help"
"-version"
"-force"
"-xterm"
"-showkeys"
"-show-keys"
"-test-status"
"-set-values"
|
>
|
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
|
(if (or (args:get-arg "-h")
(args:get-arg "-help")
(args:get-arg "--help"))
(begin
(print help)
(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))))
|
>
>
>
>
>
>
>
>
>
>
>
|
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
|
(set! *didsomething* #t)))
;;======================================================================
;; Start a repl
;;======================================================================
;; fakeout readline
(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
|
>
|
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
|
(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")
|
<
|
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 ...
(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
|
| ︙ | | | ︙ | |