520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
|
(xterm (lambda ()
(if (directory-exists? rundir)
(let* ((shell (if (get-environment-variable "SHELL")
(conc "-e " (get-environment-variable "SHELL"))
""))
(command (conc "cd " rundir
";mt_xterm -T \"" (string-translate testfullname "()" " ") "\" " shell "&")))
(print "Command =" command)
(common:without-vars
command
"MT_.*"))
(message-window (conc "Directory " rundir " not found"))))))
(xterm)
)
)
|
|
|
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
|
(xterm (lambda ()
(if (directory-exists? rundir)
(let* ((shell (if (get-environment-variable "SHELL")
(conc "-e " (get-environment-variable "SHELL"))
""))
(command (conc "cd " rundir
";mt_xterm -T \"" (string-translate testfullname "()" " ") "\" " shell "&")))
;; (print "Command =" command)
(common:without-vars
command
"MT_.*"))
(message-window (conc "Directory " rundir " not found"))))))
(xterm)
)
)
|
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
|
#:expand "YES" ;; "HORIZONTAL" ;; "VERTICAL"
;; #:scrollbar "YES"
#:numcol 1
#:numlin (length key-vals)
#:numcol-visible 1
#:numlin-visible (length key-vals)
#:click-cb (lambda (obj lin col status)
(print "obj: " obj " lin: " lin " col: " col " status: " status)))))
;; (iup:attribute-set! keys-matrix "0:0" "Run Keys")
(iup:attribute-set! keys-matrix "WIDTH0" 0)
(iup:attribute-set! keys-matrix "0:1" "Key Name")
;; (iup:attribute-set! keys-matrix "WIDTH1" "100")
;; fill in keys
(for-each
(lambda (var)
|
|
|
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
|
#:expand "YES" ;; "HORIZONTAL" ;; "VERTICAL"
;; #:scrollbar "YES"
#:numcol 1
#:numlin (length key-vals)
#:numcol-visible 1
#:numlin-visible (length key-vals)
#:click-cb (lambda (obj lin col status)
(debug:print 0 *default-log-port* "obj: " obj " lin: " lin " col: " col " status: " status)))))
;; (iup:attribute-set! keys-matrix "0:0" "Run Keys")
(iup:attribute-set! keys-matrix "WIDTH0" 0)
(iup:attribute-set! keys-matrix "0:1" "Key Name")
;; (iup:attribute-set! keys-matrix "WIDTH1" "100")
;; fill in keys
(for-each
(lambda (var)
|
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
|
(top (iup:show fd #:modal? "YES")))
(iup:attribute-set! area-name "VALUE" ;; was source-tb, no idea what is correct
(iup:attribute fd "VALUE"))
(iup:destroy! fd))))
;; (lambda (obj)
;; (iup:show (iup:file-dialog))
;; (print "File->open " obj)))
(iup:menu-item "Save" #:action (lambda (obj)(print "File->save " obj)))
(iup:menu-item "Exit" #:action (lambda (obj)(exit)))))
(iup:menu-item "Tools" (iup:menu
(iup:menu-item "Create new blah" #:action (lambda (obj)(print "Tools->new blah")))
;; (iup:menu-item "Show dialog" #:action (lambda (obj)
;; (show message-window
;; #:modal? #t
;; ;; set positon using coordinates or center, start, top, left, end, bottom, right, parent-center, current
;; ;; #:x 'mouse
;; ;; #:y 'mouse
;; )
))))
;;======================================================================
;; CANVAS STUFF FOR TESTS
;;======================================================================
(define (dcommon:draw-test cnv xoffset yoffset scalef x y w h name selected)
(let* ((llx (dcommon:x->canvas x scalef xoffset))
|
|
|
|
|
|
|
|
|
|
>
|
|
|
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
|
(top (iup:show fd #:modal? "YES")))
(iup:attribute-set! area-name "VALUE" ;; was source-tb, no idea what is correct
(iup:attribute fd "VALUE"))
(iup:destroy! fd))))
;; (lambda (obj)
;; (iup:show (iup:file-dialog))
;; (print "File->open " obj)))
;; (iup:menu-item "Save" #:action (lambda (obj)(print "File->save " obj)))
(iup:menu-item "Exit" #:action (lambda (obj)(exit)))))
;; (iup:menu-item "Tools" (iup:menu
;; (iup:menu-item "Create new blah" #:action (lambda (obj)(print "Tools->new blah")))
;; ;; (iup:menu-item "Show dialog" #:action (lambda (obj)
;; ;; (show message-window
;; ;; #:modal? #t
;; ;; ;; set positon using coordinates or center, start, top, left, end, bottom, right, parent-center, current
;; ;; ;; #:x 'mouse
;; ;; ;; #:y 'mouse
;; ;; )
;; ))
))
;;======================================================================
;; CANVAS STUFF FOR TESTS
;;======================================================================
(define (dcommon:draw-test cnv xoffset yoffset scalef x y w h name selected)
(let* ((llx (dcommon:x->canvas x scalef xoffset))
|
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
|
(colnum 1))
(if (> rownum max-row)(set! max-row rownum))
(let* ((status (vector-ref hed 3))
(val (vector-ref hed (- colnum 1)))
(bgcolor (cond
((member (conc status) '("" "-" "#<unspecified>"))
running-color)
|
<
|
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
|
(colnum 1))
(if (> rownum max-row)(set! max-row rownum))
(let* ((status (vector-ref hed 3))
(val (vector-ref hed (- colnum 1)))
(bgcolor (cond
((member (conc status) '("" "-" "#<unspecified>"))
running-color)
((member (conc status) '("0" 0))
white)
(else test-status-color)))
; (else failcolor)))
(mtrx-rc (conc rownum ":" colnum)))
;;(print "BB> status=>"status"< bgcolor="bgcolor)
(iup:attribute-set! steps-matrix mtrx-rc (if val (conc val) ""))
|