Megatest

Diff
Login

Differences From Artifact [9acb2d697e]:

To Artifact [587da77d0a]:


520
521
522
523
524
525
526
527

528
529
530
531
532
533
534
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)
                                 ;; (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
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)))))
                                     (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
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 "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
			   ;;  )					     
			   ))))
;; (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
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) ""))