20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
(declare (unit tree))
(declare (uses margs))
(declare (uses launch))
(declare (uses megatest-version))
(declare (uses gutils))
(declare (uses db))
(declare (uses server))
(declare (uses synchash))
(declare (uses dcommon))
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
;;======================================================================
|
|
|
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
(declare (unit tree))
(declare (uses margs))
(declare (uses launch))
(declare (uses megatest-version))
(declare (uses gutils))
(declare (uses db))
(declare (uses server))
;; (declare (uses synchash))
(declare (uses dcommon))
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
;;======================================================================
|
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
;; top is the top node name zeroeth node VALUE=0
(define (tree:add-node obj top nodelst #!key (userdata #f))
(let ((curr-top (iup:attribute obj "TITLE0")))
(if (or (not (string? curr-top))
(string-null? curr-top)
(string-match "^\\s*$" curr-top))
(iup:attribute-set! obj "ADDBRANCH0" top))
|
|
>
>
>
|
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
;; top is the top node name zeroeth node VALUE=0
(define (tree:add-node obj top nodelst #!key (userdata #f))
(let ((curr-top (iup:attribute obj "TITLE0")))
(if (or (not (string? curr-top))
(string-null? curr-top)
(string-match "^\\s*$" curr-top))
(iup:attribute-set! obj "ADDBRANCH0" top))
(cond
((not (equal? top (iup:attribute obj "TITLE0")))
(print "ERROR: top name " top " doesn't match " (iup:attribute obj "TITLE0")))
((null? nodelst))
(else
(let loop ((hed (car nodelst))
(tal (cdr nodelst))
|