Megatest

Check-in [1f80fdebfa]
Login
Overview
Comment:Multi-dashboard changes
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | mtdboard_defunct
Files: files | file ages | folders
SHA1: 1f80fdebfac822ff8f1db76128bf458a14da4978
User & Date: ritikaag on 2016-03-22 14:52:05
Other Links: branch diff | manifest | tags
Context
2016-04-21
09:59
Added popup-menu based on Thomas Chust's feedback check-in: a43a49988b user: mrwellan tags: mtdboard_defunct
2016-03-22
14:52
Multi-dashboard changes check-in: 1f80fdebfa user: ritikaag tags: mtdboard_defunct
2016-03-15
23:42
More dashboard refactoring check-in: 705ae1d971 user: matt tags: v1.60_defunct
Changes

Modified configf.scm from [d0b9504482] to [db46ea817f].

38
39
40
41
42
43
44






45
46
47
48
49
50
51
		  (loop remcwd)))))))))

(define (config:assoc-safe-add alist key val #!key (metadata #f))
  (let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist)))
    (append newalist (list (if metadata
			       (list key val metadata)
			       (list key val))))))







(define (config:eval-string-in-environment str)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 "ERROR: problem evaluating \"" str "\" in the shell environment")
     #f)







>
>
>
>
>
>







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
		  (loop remcwd)))))))))

(define (config:assoc-safe-add alist key val #!key (metadata #f))
  (let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist)))
    (append newalist (list (if metadata
			       (list key val metadata)
			       (list key val))))))


(define (configf:set-section-var cfgdat section var value)
  (let ((sect (hash-table-ref/default cfgdat section '())))
    (hash-table-set! cfgdat section (config:assoc-safe-add sect var value))))


(define (config:eval-string-in-environment str)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 "ERROR: problem evaluating \"" str "\" in the shell environment")
     #f)
594
595
596
597
598
599
600


	      (let* ((var (car dat-pair))
		     (val (cadr dat-pair))
		     (fname (if (> (length dat-pair) 2)(caddr dat-pair) #f)))
		(if fname (print "# " var "=>" fname))
		(print var " " val)))
	    section-dat))) ;;       (print "section-dat: " section-dat))
   (hash-table->alist data)))









>
>
600
601
602
603
604
605
606
607
608
	      (let* ((var (car dat-pair))
		     (val (cadr dat-pair))
		     (fname (if (> (length dat-pair) 2)(caddr dat-pair) #f)))
		(if fname (print "# " var "=>" fname))
		(print var " " val)))
	    section-dat))) ;;       (print "section-dat: " section-dat))
   (hash-table->alist data)))


Modified multi-dboard.scm from [3d4abbfc1d] to [e86b128f19].

161
162
163
164
165
166
167

168
169
170
171
172
173
174
(define-record data
  cfgdat             ;; data from ~/.megatest/<group>.dat
  areas              ;; hash of areaname -> area-rec
  current-window-id  ;; 
  current-tab-id     ;; 
  update-needed      ;; flag to indicate that the tab pointed to by current tab id needs refreshing immediately
  tabs               ;; hash of tab-id -> areaname (??) should be of type "tab"

  )

;; all the components of an area display, all fits into a tab but
;; parts may be swapped in/out as needed
;;
(define-record tab
  tree







>







161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
(define-record data
  cfgdat             ;; data from ~/.megatest/<group>.dat
  areas              ;; hash of areaname -> area-rec
  current-window-id  ;; 
  current-tab-id     ;; 
  update-needed      ;; flag to indicate that the tab pointed to by current tab id needs refreshing immediately
  tabs               ;; hash of tab-id -> areaname (??) should be of type "tab"
  groupn             ;; 
  )

;; all the components of an area display, all fits into a tab but
;; parts may be swapped in/out as needed
;;
(define-record tab
  tree
515
516
517
518
519
520
521






































522
523
524
525
526
527
528
   ;; (dboard:clear-matrix current-matrix used-cols used-rows touched) ;; clear all
    
	
  
;;======================================================================
;; D A S H B O A R D
;;======================================================================







































(define (dashboard:area-panel aname data window-id)
  (let* ((apath      (configf:lookup (data-cfgdat data) aname "path")) ;;  (hash-table-ref (dboard:data-cfgdat data) area-name))
	 ;;          (hash-table-ref (dboard:data-cfgdat data) aname))
	 (area-dat   (dashboard:init-area data aname apath))
	 (tb         (dashboard:tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data)
	 (ad         (dashboard:main-matrix  data area-dat window-id))







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
   ;; (dboard:clear-matrix current-matrix used-cols used-rows touched) ;; clear all
    
	
  
;;======================================================================
;; D A S H B O A R D
;;======================================================================

;; The main menu
(define (dcommon:main-menu data)
  (iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top)
   (iup:menu-item "Files" (iup:menu   ;; Note that you can use either #:action or action: for options
			   (iup:menu-item "Open"  action: (lambda (obj)
							    (let* ((area-name (iup:textbox #:expand "HORIZONTAL"))
								   (fd        (iup:file-dialog #:dialogtype "DIR"))
								   (top       (iup:show fd #:modal? "YES")))
							      (iup:attribute-set! source-tb "VALUE"
										  (iup:attribute fd "VALUE"))
                                                              (iup:destroy! fd))))
                           (iup:menu-item "Open area"  action: (lambda (obj)
                                                            (let* ((area-name (iup:textbox #:expand "HORIZONTAL"))
                                                                   (fd        (iup:file-dialog #:dialogtype "DIR"))
                                                                   (top       (iup:show fd #:modal? "YES"))
                                                                   ;;(source-tb (iup:textbox #:expand "HORIZONTAL"))
                                                                   (cfgdat    (data-cfgdat data))
                                                                   (fname     (conc (getenv "HOME") "/.megatest/" (data-groupn data) ".dat"))
                                                                   )
                                                              ;;(iup:attribute-set! source-tb "VALUE"
                                                              ;;                    (iup:attribute fd "VALUE"))
                                                               (configf:set-section-var cfgdat "lvqa" "path" (iup:attribute fd "VALUE"))
                                                               (configf:write-alist cfgdat fname)
							      (iup:destroy! fd))))		      
                           (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
			   ;;  )					     
			   ))))


(define (dashboard:area-panel aname data window-id)
  (let* ((apath      (configf:lookup (data-cfgdat data) aname "path")) ;;  (hash-table-ref (dboard:data-cfgdat data) area-name))
	 ;;          (hash-table-ref (dboard:data-cfgdat data) aname))
	 (area-dat   (dashboard:init-area data aname apath))
	 (tb         (dashboard:tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data)
	 (ad         (dashboard:main-matrix  data area-dat window-id))
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566


;; Main Panel
;;
(define (dashboard:main-panel data window-id)
  (iup:dialog
   #:title "Megatest Control Panel"
;;   #:menu (dcommon:main-menu data)
   #:shrink "YES"
   (iup:vbox
    (let* ((area-names  (hash-table-keys (data-cfgdat data)))
	   (area-panels (map (lambda (aname)
			       (dashboard:area-panel aname data window-id))
			     area-names))
	   (tabtop      (apply iup:tabs  







|







591
592
593
594
595
596
597
598
599
600
601
602
603
604
605


;; Main Panel
;;
(define (dashboard:main-panel data window-id)
  (iup:dialog
   #:title "Megatest Control Panel"
   #:menu (dcommon:main-menu data)
   #:shrink "YES"
   (iup:vbox
    (let* ((area-names  (hash-table-keys (data-cfgdat data)))
	   (area-panels (map (lambda (aname)
			       (dashboard:area-panel aname data window-id))
			     area-names))
	   (tabtop      (apply iup:tabs  
769
770
771
772
773
774
775

776
777
778
779
780
781
782
	 (data      (make-data
		     cfgdat ;; this is the data from ~/.megatest for the selected group
		     (make-hash-table) ;; areaname -> area-rec
		     0                 ;; current window id
		     0                 ;; current tab id
		     #f                ;; redraw needed for current tab id
		     (make-hash-table) ;; tab-id -> areaname

		     )))
    (hash-table-set! *windows* window-id data)
    (iup:show (dashboard:main-panel data window-id))
    (iup:main-loop)))

;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))







>







808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
	 (data      (make-data
		     cfgdat ;; this is the data from ~/.megatest for the selected group
		     (make-hash-table) ;; areaname -> area-rec
		     0                 ;; current window id
		     0                 ;; current tab id
		     #f                ;; redraw needed for current tab id
		     (make-hash-table) ;; tab-id -> areaname
                     groupn
		     )))
    (hash-table-set! *windows* window-id data)
    (iup:show (dashboard:main-panel data window-id))
    (iup:main-loop)))

;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))