327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
|
(begin
;; if not list or kill then start a client (if appropriate)
(if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test")
(eq? (length (hash-table-keys args:arg-hash)) 0))
(debug:print-info 1 "Server connection not needed")
;; ok, so lets connect to the server
(let ((transport-from-config (configf:lookup *configdat* "setup" "transport"))
(transport-from-cmdln (args:get-arg "-transport")))
(cond
((and transport-from-config (not (equal? transport-from-config "fs")))
(server:ensure-running)
(client:launch))
((and transport-from-cmdln (not (equal? transport-from-cmdln "fs")))
(server:ensure-running)
(client:launch))
(else
(set! *transport-type* 'fs)))))))))
(if (or (args:get-arg "-list-servers")
(args:get-arg "-stop-server"))
(let ((tl (setup-for-run)))
(if tl
|
|
|
>
>
>
>
>
>
>
|
>
>
|
|
>
>
|
>
>
|
|
>
>
>
>
>
>
>
|
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
|
(begin
;; if not list or kill then start a client (if appropriate)
(if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test")
(eq? (length (hash-table-keys args:arg-hash)) 0))
(debug:print-info 1 "Server connection not needed")
;; ok, so lets connect to the server
(let ((transport-from-config (configf:lookup *configdat* "setup" "transport"))
(transport-from-cmdln (args:get-arg "-transport"))
(transport-from-cmdinfo (if (getenv "MT_CMDINFO")
(assoc 'transport
(read (open-input-string (base64:base64-decode
(getenv "MT_CMDINFO")))))
#f)))
(cond
;; command line overrides other mechanisms
(transport-from-cmdln
(if (equal? transport-from-cmdln "fs")
(set! *transport-type* 'fs)
(begin
(server:ensure-running)
(client:launch))))
;; cmdinfo is second priority
(transport-from-cmdinfo
(if (equal? transport-from-cmdinfo "fs")
(set! *transport-type* 'fs)
(begin
(server:ensure-running)
(client:launch))))
;; config file is next highest priority for determinining transport
(transport-from-config
(if (equal? transport-from-config "fs")
(set! *transport-type* 'fs)
(begin
(server:ensure-running)
(client:launch))))
(else
(set! *transport-type* 'fs)))))))))
(if (or (args:get-arg "-list-servers")
(args:get-arg "-stop-server"))
(let ((tl (setup-for-run)))
(if tl
|
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
|
(args:get-arg "-load"))
(let* ((toppath (setup-for-run))
(db (if toppath (open-db) #f)))
(if db
(begin
(set! *db* db)
(set! *client-non-blocking-mode* #t)
;; (client:setup)
;; (client:launch)
|
<
<
|
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
|
(args:get-arg "-load"))
(let* ((toppath (setup-for-run))
(db (if toppath (open-db) #f)))
(if db
(begin
(set! *db* db)
(set! *client-non-blocking-mode* #t)
(import readline)
(import apropos)
(gnu-history-install-file-manager
(string-append
(or (get-environment-variable "HOME") ".") "/.megatest_history"))
(current-input-port (make-gnu-readline-port "megatest> "))
(if (args:get-arg "-repl")
|