1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
|
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
|
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
|
;; (run-id (db:test-get-run_id (vector-ref buttndat 3)))
;; (cmd (conc toolpath " -test " run-id "," test-id "&")))
;; ;(print "Launching " cmd)
;; (system cmd)))
#:button-cb (lambda (obj a pressed x y btn . rem)
(print "pressed= " pressed " x= " x " y= " y " rem=" rem " btn=" btn " string? " (string? btn))
(if (substring-index "3" btn)
(if (eq? pressed 0)
(let ((popup-menu (iup:menu
(iup:menu-item
"Run"
(iup:menu
(iup:menu-item
"Rerun"
#:action
(lambda (obj)(print "Rerun")))
(if (eq? pressed 1)
(let* ((toolpath (car (argv)))
(buttndat (hash-table-ref (d:alldat-buttondat *alldat*) button-key))
(test-id (db:test-get-id (vector-ref buttndat 3)))
(run-id (db:test-get-run_id (vector-ref buttndat 3)))
(test-name (db:test-get-testname (rmt:get-test-info-by-id run-id test-id)))
(popup-menu (iup:menu
(iup:menu-item
"Run"
(iup:menu
(iup:menu-item
"Rerun"
#:action
(lambda (obj)(print "Rerun")))))
(iup:menu-item
"Test"
(iup:menu
(iup:menu-item
"Start xterm"
#:action
(let* ((toolpath (car (argv)))
"Start xterm"
#:action
(lambda (obj)
(buttndat (hash-table-ref (d:alldat-buttondat *alldat*) button-key))
(test-id (db:test-get-id (vector-ref buttndat 3)))
(run-id (db:test-get-run_id (vector-ref buttndat 3)))
(cmd (conc toolpath " -xterm " run-id "," test-id "&")))
(system cmd))
;; (lambda (x)
(let* ((cmd (conc toolpath " -xterm " run-id "," test-id "&")))
(system cmd))))
(iup:menu-item
"Edit testconfig"
#:action
(lambda (obj)
;; (if (directory-exists? rundir)
;; (let ((shell (if (get-environment-variable "SHELL")
;; (conc "-e " (get-environment-variable "SHELL"))
(let* ((all-tests (tests:get-all))
(editor (or (get-environment-variable "VISUAL")
(get-environment-variable "EDITOR") "gvim"))
;; "")))
;; (common:without-vars
;; (conc "cd " rundir
;; ";mt_xterm -T \"" (string-translate testfullname "()" " ") "\" " shell "&")
(tconfig (conc (hash-table-ref all-tests test-name) "/testconfig"))
(cmd (conc (if (string-search "\\b(vim?|nano|pico)\\b")
;; "MT_.*"))
;; (message-window (conc "Directory " rundir " not found"))))
))))))
(iup:show popup-menu
#:x 'mouse
#:y 'mouse
#:modal? "NO")
(print "got here")))
(conc "xterm -e " editor)
editor)
" " tconfig)))
(system cmd))))
)))))
(iup:show popup-menu
#:x 'mouse
#:y 'mouse
#:modal? "NO")
(print "got here")))
(if (eq? pressed 0)
(let* ((toolpath (car (argv)))
(buttndat (hash-table-ref (d:alldat-buttondat *alldat*) button-key))
(test-id (db:test-get-id (vector-ref buttndat 3)))
(run-id (db:test-get-run_id (vector-ref buttndat 3)))
(cmd (conc toolpath " -test " run-id "," test-id "&")))
(system cmd)))
|