File: desc_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 (143 lines) | stat: -rw-r--r-- 3,868 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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
/*
 * @progname    desc_ged.ll
 * @version     1
 * @author      Nicklaus
 * @category
 * @output      Text
 * @description
	        Generate gedcom of descendents.
		For specified set of individuals for specified # of generations
		down from the top individuals. (e.g. name all your great-grandparents
		for all of your close cousins in one gedcom file)

	Author:  Dennis Nicklaus  nicklaus@fnal.gov  June 1997
*/
/* MODIFY this to put in your name and address! */
proc print_header()
{
  "0 HEAD\n"
  "1 SOUR LIFELINES\n"
  "2 VERS 3.0.2\n"
  "2 NAME LifeLines for UNIX\n"
  "1 DATE " stddate(gettoday()) nl()
  "0 @SM1@ SUBM\n"
  "1 NAME your name here\n"
  "1 ADDR your street here\n"
  "2 CONT your town\n"
  "2 CONT your email\n"
}

proc main ()
{
    getindimsg(person,"Enter person to output GEDCOM descendants of")
    indiset(thisgen)
    indiset(allgen)
    while (person){
	addtoset(thisgen, person, 0)
	addtoset(allgen, person, 0)

	set(person,0)
        getindimsg(person,"Enter next person to output GEDCOM descendants of")
     }

    set(allgen, union(allgen,spouseset(allgen)))
    getintmsg (ngen,
               "Enter number of generations")
    set(gen,1)
    while(and(lengthset(thisgen),le(gen,ngen))) {
        set (thisgensize,lengthset(thisgen))
        print ("generation ",d(gen)," ",d(thisgensize))
        if (gt(thisgensize,1)) {
            print(" people\n")
         } else {
            print(" person\n")
         }
        set(gen,add(gen,1))

        set(thisgen,childset(thisgen))
        set(allgen,union(allgen,thisgen))
        set(allgen,union(allgen,spouseset(thisgen)))
    }
    call print_header()
    gengedcom(allgen)

        call sour_init()
        call sour_addset(allgen)
        call sour_ged()

    "0 TRLR\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"
                }
        }
}