File: find.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 (157 lines) | stat: -rw-r--r-- 3,595 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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
/*
 * @progname       find.ll
 * @version        2.1
 * @author         Prinke, Perry Rapp
 * @category       
 * @output         GUI
 * @description    Display menu of persons with TAG having matching VALUE

This utility finds all persons whose records contain a specified
TAG and VALUE and displays the resulting list as a menu.

   find.ll - Rafal Prinke, rafalp@plpuam11.amu.edu.pl, 7 OCT 1995

The options allow to:

- find all occurrences of a given TAG when no VALUE is given
- find all occurrences of a given VALUE when no TAG is given
- find all occurrences of a given VALUE under a given TAG when
       both are given (the CONT|CONC|TYPE tags are also searched)

The displayed VALUE is a 25 characters long substring of the field
value starting from the first occurence of the input value.

The results are displayed in a menuchoice list.
The first choice is to print the remaining choices to a file.
*/
option(explicit)

proc main()
{
  list(mnu)

  getstr(tg, "TAG (enter=ANY)")
  set(tg, upper(tg))

  getstr(vl, "VALUE (enter=ANY)")
  set(vl, upper(vl))

  while (1)
  {
    getstr(rtype, "Records to search (I, F, S, E, X, or <enter> for any)")
    set(rtype, upper(rtype))
    if (or(eq(rtype, ""), index("IFSEX", rtype, 1)))
    {
       break()
    }
  }

  set(outputChoice, "Print to output file")
  enqueue(mnu, outputChoice)

  /* people */
  if (or(eq(rtype, ""), eq(rtype, "I")))
  {
    forindi (rec, n)
    {
      call search(rec, tg, vl, mnu)
    }
  }
  /* families */
  if (or(eq(rtype, ""), eq(rtype, "F")))
  {
    forfam (rec, n)
    {
      call search(rec, tg, vl, mnu)
    }
  }
  /* sources */
  if (or(eq(rtype, ""), eq(rtype, "S")))
  {
    forsour (rec, n)
    {
      call search(rec, tg, vl, mnu)
    }
  }
  /* events */
  if (or(eq(rtype, ""), eq(rtype, "E")))
  {
    foreven (rec, n)
    {
      call search(rec, tg, vl, mnu)
    }
  }
  /* others */
  if (or(eq(rtype, ""), eq(rtype, "X")))
  {
    forothr (rec, n)
    {
      call search(rec, tg, vl, mnu)
    }
  }

  if (eq(length(mnu), 1))
  {
    print("No matches found")
  }
  else
  {
    set(chc, menuchoose(mnu, "Use record keys as below to browse to desired record"))
    if (eq(chc, 1))
    {
      "Search for tag <" tg "> and value <" vl ">"
      if (eq(rtype, "")) { " in all records" }
      else { " in " rtype " records" }
      " yielded " d(sub(length(mnu), 1)) " hits:\n"
      forlist(mnu,s,c) {
        if (ne(s, outputChoice))
        {
          s nl()
        }
      }
    }
  }
}

/*
 Search rec (an INDI or FAM or ...)
  for occurrences of tag tg with value vl
  (Either may be empty as wildcards)
*/
proc search(rec, tg, vl, mnu)
{
  set(rnod, root(rec))
  set(nodtyp, tag(rnod))
  traverse (rnod, n, x)
  {
    set(xtag, upper(tag(n)))
    set(xval, upper(value(n)))
    if (eq(strlen(vl), 0))
    {
      set(ofst, 1) 
    }
    else
    {
      set(ofst, index(xval, vl, 1)) 
    }
    if (or(or(and(eqstr(tg, xtag), or(index(xval, vl, 1),
        eq(strlen(vl), 0))), and(eq(strlen(tg), 0), index(xval, vl, 1))),
        and(index("CONTYPECONC", xtag, 1), index(xval, vl, 1)))) 
    {
      set(z, substring(value(n), ofst, strlen(xval)))
      if (gt(strlen(z), 25))
      {
        set(z, substring(z, 1, 25))
      }
      set(result, concat(rjustify(key(rec), 6), " - "))
      if (eq(nodtyp, "INDI"))
      {
        set(result, concat(result,
           rjustify(fullname(rec, 1, 1, 18), 18)))
      }
      set(result, concat(result, 
         " - ", tag(parent(n)), ":", d(x), "_", tag(n), ":", z))
      enqueue(mnu, result)
    }
  } /* traverse */
}