File: anc2_ged.ll

package info (click to toggle)
lifelines 3.0.50-2
  • links: PTS
  • area: main
  • in suites: etch-m68k
  • size: 11,140 kB
  • ctags: 6,517
  • sloc: ansic: 57,468; xml: 8,014; sh: 4,255; makefile: 848; yacc: 601; perl: 170; sed: 16
file content (117 lines) | stat: -rw-r--r-- 3,001 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
/*
 * @progname    anc2_ged.ll
 * @version     1.0
 * @author      Dennis Nicklaus
 * @category
 * @output      GedCom
 * @description
 *              make a gedcom file of the ancestors of a set of individuals
 *
 */
proc main ()
{
        indiset(a)
        monthformat(4)
        indiset(b)
        getindi(i)

    while (i){
        addtoset(a, i, 0)
        set(i,0)
        getindimsg(i,"Enter next person to output GEDCOM ancestors of")
     }
        set(b,ancestorset(a))
        set(b,union(b,a))

        call print_header()
        gengedcom(b)
        call sour_init()
        call sour_addset(b)
        call sour_ged()

    "0 TRLR\n"

}

proc print_header()
{
  "0 HEAD\n"
  "1 SOUR Lifelines\n"
  "1 DATE " stddate(gettoday()) nl()
  "0 @SM1@ SUBM\n"
  "1 NAME " getproperty("user.fullname") "\n"
  "1 ADDR " getproperty("user.address") "\n"
  "2 CONT " getproperty("user.email") "\n"
}
global(sour_list)
global(sour_table)

proc sour_init()
{
        table(sour_table)
        list(sour_list)
}
/* sour_addind() adds the sources referenced for this individual */

proc sour_addind(i)
{
         traverse(root(i), m, l) {
                if (nestr("SOUR", tag(m))) { continue() }
                set(v, value(m))
                if (eqstr("", v)) { continue() }
                if(reference(v)) {
                          if (ne(0, lookup(sour_table, v))) { continue() }
                          set(v, save(v))
                          insert(sour_table, v, 1)
                          enqueue(sour_list, v)
                }
         }
}

proc sour_addset(s)
{
        forindiset (s, i, a, n) {
                call sour_addind(i)
                families(i, f, sp, m) {
                  call sour_addind(f)
                }
        }
}

/* sour_ged() outputs the current source list in GEDCOM format */

proc sour_ged()
{
        table(other_table)
        list(other_list)

        forlist(sour_list, k, n) {
                set(r, dereference(k))
                traverse(r, s, l) {
                        d(l)
                        if (xref(s)) { " " xref(s) }
                        " " tag(s)
                        if (v, value(s)) {
                          " " v
                          if(reference(v)) {
                            if (ne(0, lookup(other_table, v))) { continue() }
                            if (ne(0, lookup(sour_table, v))) { continue() }
                            set(v, save(v))
                            insert(other_table, v, 1)
                            enqueue(other_list, v)
                          }
                        }
                        "\n"
                }
        }
        forlist(other_list, k, n) {
                set(r, dereference(k))
                traverse(r, s, l) {
                        d(l)
                        if (xref(s)) { " " xref(s) }
                        " " tag(s)
                        if (v, value(s)) { " " v }
                        "\n"
                }
        }
}