Overview
Comment: | Auto create config as needed |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.60 |
Files: | files | file ages | folders |
SHA1: |
20fc7c693cb0073cafebb207a8bf880d |
User & Date: | mrwellan on 2015-06-17 15:26:27 |
Other Links: | branch diff | manifest | tags |
Context
2015-06-18
| ||
00:39 | More on multi-dboard check-in: b8e14b73cd user: matt tags: v1.60 | |
2015-06-17
| ||
15:26 | Auto create config as needed check-in: 20fc7c693c user: mrwellan tags: v1.60 | |
2015-06-16
| ||
23:52 | Added back multi-dboard, now compiles and starts check-in: a3c6474166 user: matt tags: v1.60 | |
Changes
Modified multi-dboard.scm from [fddd27242f] to [2a11a744b1].
︙ | ︙ | |||
68 69 70 71 72 73 74 | ;; (if (args:get-arg "-host") ;; (begin ;; (set! (common:get-remote remote) (string-split (args:get-arg "-host" ":"))) ;; (client:launch)) ;; (client:launch)) | < < < < < | 68 69 70 71 72 73 74 75 76 77 78 79 80 81 | ;; (if (args:get-arg "-host") ;; (begin ;; (set! (common:get-remote remote) (string-split (args:get-arg "-host" ":"))) ;; (client:launch)) ;; (client:launch)) (define *runremote* #f) (debug:setup) (define *tim* (iup:timer)) (define *ord* #f) |
︙ | ︙ | |||
294 295 296 297 298 299 300 | (tabtop (apply iup:tabs #:tabchangepos-cb (lambda (obj curr prev) (data-current-tab-id-set! data curr) (data-update-needed-set! data #t) (print "Tab is: " curr ", prev was " prev)) area-panels)) (tab-ids (data-tab-ids data))) | > | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > > > > | 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 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 370 371 372 373 374 375 | (tabtop (apply iup:tabs #:tabchangepos-cb (lambda (obj curr prev) (data-current-tab-id-set! data curr) (data-update-needed-set! data #t) (print "Tab is: " curr ", prev was " prev)) area-panels)) (tab-ids (data-tab-ids data))) (if (not (null? area-names)) (let loop ((index 0) (hed (car area-names)) (tal (cdr area-names))) (hash-table-set! tab-ids index hed) (debug:print 0 "Adding area " hed " with index " index " to dashboard") (iup:attribute-set! tabtop (conc "TABTITLE" index) hed) (if (not (null? tal)) (loop (+ index 1)(car tal)(cdr tal))))) tabtop)))) ;;====================================================================== ;; C O N F I G U R A T I O N ;;====================================================================== ;; Get the configuration file for a group name, if the group name is "default" and it doesn't ;; exist, create it and add the current path if it contains megatest.config ;; (define (dboard:get-config group-name) (let* ((fname (conc (getenv "HOME") "/.megatest/" group-name ".dat"))) (if (file-exists? fname) (read-config fname (make-hash-table) #t) (if (dboard:create-config fname) (dboard:get-config group-name) (make-hash-table))))) (define (dboard:create-config fname) ;; (handle-exceptions ;; exn ;; ;; #f ;; failed to create - just give up (let* ((dirname (pathname-directory fname)) (file-name (pathname-strip-directory fname)) (curr-mtcfgdat (find-config "megatest.config" toppath: (or (get-environment-variable "MT_RUN_AREA_HOME")(current-directory)))) (curr-mtcfg (if (and curr-mtcfgdat (not (null? curr-mtcfgdat)))(cadr curr-mtcfgdat) #f)) (curr-mtpath (if curr-mtcfg (car curr-mtcfgdat) #f))) (if curr-mtpath (begin (debug:print-info 0 "Creating config file " fname) (if (not (file-exists? dirname)) (create-directory dirname #t)) (with-output-to-file fname (lambda () (let ((aname (pathname-strip-directory curr-mtpath))) (print "[" aname "]") (print "path " curr-mtpath)))) #t) (begin (debug:print-info 0 "Need to create a config but no megatest.config found: " curr-mtcfgdat) #f)))) ;; ) ;;; main. Theoretically could have multiple windows (each with a group of tags, thus window-id ;;; (define (dboard:make-window window-id) (let* (;; (window-id 0) (groupn (or (args:get-arg "-group") "default")) (cfgdat (dboard:get-config groupn)) ;; (cfgdat (if (file-exists? cfname)(read-config cfname (make-hash-table) #t)(make-hash-table))) (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 ))) (iup:show (dashboard:main-panel data window-id)) (iup:main-loop))) ;; ease debugging by loading ~/.dashboardrc (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc"))) (if (file-exists? debugcontrolf) (load debugcontrolf))) (dboard:make-window 0) |