From owner-lines-l@VM1.NODAK.EDU Sun Jun  4 12:20 EDT 1995
Return-Path: <owner-lines-l@VM1.NODAK.EDU>
Received: from stsci.edu (marvel.stsci.edu) by hoth.stsci.edu (5.x/SMI-SVR4-DNI-8.0)
	id AA12725; Sun, 4 Jun 1995 12:20:28 -0400
Received: from hydra.stsci.edu by stsci.edu (5.x/SMI-SVR4-DNI-8.0)
	id AA28312; Sun, 4 Jun 1995 12:20:25 -0400
Received: Sun, 4 Jun 95 11:20:22 EST from stsci.edu (marvel.stsci.edu) by hydra.stsci.edu (4.1)
Received: from VM1.NoDak.EDU by stsci.edu (5.x/SMI-SVR4-DNI-8.0)
	id AA28309; Sun, 4 Jun 1995 12:20:17 -0400
Received: from VM1.NODAK.EDU by VM1.NoDak.EDU (IBM VM SMTP V2R2)
   with BSMTP id 0809; Sun, 04 Jun 95 11:04:08 CDT
Received: from VM1.NODAK.EDU (NJE origin LISTSERV@NDSUVM1) by VM1.NODAK.EDU (LMail V1.2a/1.8a) with BSMTP id 3522; Sun, 4 Jun 1995 11:02:40 -0500
Message-Id: <9506041620.AA28309@stsci.edu>
Date:         Sun, 4 Jun 1995 09:11:51 -0600
Reply-To: LifeLines Genealogical System <LINES-L@VM1.NoDak.EDU>
Sender: LifeLines Genealogical System <LINES-L@VM1.NoDak.EDU>
From: Doug McCallum <dougm@CSN.ORG>
Subject:      An register report program generating RTF
To: Multiple recipients of list LINES-L <LINES-L@VM1.NoDak.EDU>
Content-Type: text
Content-Length: 62233
Status: RO

In anticipation of the eventual Mac version of LifeLines, I've put
together an RTF library and program to generate a register report that
can then be imported into a word processing program that can read RTF
(like MS Word).  It has been tested with Word on both Mac and Windows.
It has a lot of options that are documented in the file.  It runs
under lines 3.0.2 since it uses the include() feature.  The rtflib
file could be pulled into the source to run it on earlier versions.

Some of the options include:
- indexing all persons with page numbers being bold for main entry,
  normal when indexed as child and italic when appearing as spouse.
- descendents in table of contents.
- output any notes found
- list either all children or separate by other parent

It also goes to great pains to minimize output when a descendent can
appear more than once in the report due to having cousins marrying.

Doug McCallum
dougm@csn.net

--------------- cut here and run through /bin/sh to unpack -----------------
#!/bin/sh
sed -e 's/^X//' <<'!EOF!' >register-rtf
X/*
X * RTF based Register Report Generator
X *     written by Doug McCallum
X *     Version 1.6
X * This program has many options but basically takes a person
X * and generates an RTF document that can be read by a number
X * of word processors.  The document can optionally be cross-indexed
X * and footnoted.  The format is close to the NEHGS Register Form.
X *
X * Options are set by setting variables at the beginning of main
X * The options are:
X *     option          values
X *     -------------   ----------------------------------------------------
X *     doindex         0 == no index, 1 == create index
X *     prefix          a string.  This is prefixed to the standard
X *                     numbers for people
X *     donotes         0 == don't output notes, 1 == output notes in-line
X *                     2 == output notes at end with a reference in text
X *     author          a string used in the author info field
X *     strictness      0 == all descendents, 1 == modified form, 2 = strict
X *     childby         0 == list children together, 1 == indicate parent by
X *     titlepage       0 == no title page, 1 == generate title page
X *     dosources       0 == don't output sources, 1 == output sources
X *     occupation      0 == don't output occupation, 1 == output occupation
X *
X * Not implemented yet:
X *     showrefn        0 == don't show user refn tags, 1 == show tags
X *
X *
X * Notes:
X *     when an index is created, it must be turned on in the word processor
X *     since only the indexing is actually done.  Each time a name is seen
X *     it is indexed.  If the name is a reference to the person as child of,
X *     then it is indexed in plain form numbers.  If the person is a spouse
X *     the page number is italic and if the person is the first entry in
X *     the family info, then the page number is bold.
X *
X *     The "prefix" is intended for use when doing multifamily reports.
X *     Further work needs to be done, but it can get you quite a ways
X *     toward that end.  A future version of this program may handle
X *     the multi-family case directly.
X *
X *     If notes are done in-line, each NOTE is a new paragraph and blank
X *     lines mark paragraphs.  If done as endnotes, the NOTES are indicated
X *     with ids in the form [id1, id2] and then a Notes page created to
X *     print all the notes.
X *
X *     All main lines and the Generation lines are treated as headings and
X *     can be put into a table of contents. This is always done but the
X *     table is not inserted into the document.
X *
X *     If a marriage would occur multiple times, it is only referred
X *     to and not duplicated after the first time.  This is complicated
X *     by an indi having multiple marriages and the duplicated spouse
X *     also having multiple marriages with only one marriage in the duplicate
X *     tree. These are called out as well.
X *
X *     I don't plan to implement the generation tags (superscript generation
X *     numbers) on individuals at this point.  They are easy enough to do
X *     since the current generation is always known but I find them not
X *     particularly useful in the text.
X *
X *     The program can take a long time since it manipulates a lot of data.
X *     Future versions may improve performance as better algorithms are
X *     found.
X *
X *     An individual's occupation(s) should be output into the report
X *     but isn't currently done.  This probably should be an option along
X *     with the specific format to use.
X *
X *     A future version should replace all occurrences of English
X *     text with variable references to make translation easier. Mostly
X *     this is the label stuff (b., d., bur., children, etc.).  There should
X *     also be an option to expand the abbreviations to the full word.
X *
X *     At some point, information such as the various baptism, christening,
X *     and other event information will be included as well.  This will
X *     most likely be done as hidden text of some form or perhaps as
X *     annotations.  This will make the text available but it would have
X *     to be turned on in the document.
X *
X *     Sources should eventually be turned into endnotes so Word can do
X *     any special processing.
X */
Xinclude("rtflib/rtflib")
Xglobal(childby)
Xglobal(curr_index)
Xglobal(doindex)
Xglobal(donotes)
Xglobal(dosources)
Xglobal(endtags)
Xglobal(generation)
Xglobal(inum_set)
Xglobal(nextgen)
Xglobal(prev_fam_list)
Xglobal(strictness)
Xglobal(taglist)
Xglobal(titlepage)
Xglobal(all_sources)
Xglobal(occupation)
X
Xproc main()
X{
X       /* program options */
X       set(doindex, 1)         /* set to zero if you don't want an index */
X       set(prefix, "")         /* string to prefix indi number with */
X       set(donotes, 1)         /* 0 = no notes, 1 = inline, 2 = end */
X       set(dosources, 1)       /* 0 = no sources, 1 = sources */
X       set(childby, 1)         /* 0 = all children, 1 = children by spouse */
X       set(strictness, 0)      /* all descendents, including female lines */
X       set(occupation, 1)
X       set(author, "Author/Compiler Name") /* default author name */
X       set(titlepage, 1)       /* want a title page */
X
X       set(now, gettoday())
X       dayformat(1)
X       monthformat(1)
X       dateformat(8)
X       set(created, stddate(now))
X
X       /* program proper */
X
X       /* initialize the variables used */
X
X       indiset(inum_set)       /* this set keeps the family numbers */
X       list(prev_fam_list)     /* keeps track of marriages to avoid dups */
X       list(generation)        /* current generation being processed */
X       list(nextgen)           /* next generation to process */
X       table(endtags)          /* if notes at end, keep track of tags */
X       list(taglist)           /* the tags in order created */
X       set(curr_index, 0)      /* current index for indi/family */
X       set(curr_gen, 0)        /* current generation counter */
X       set(indi,0)
X       list(all_sources)       /* contains list of all sources referenced */
X
X       getindi(indi)
X       if (not(indi)) {
X               /* if no one selected, exit */
X               return (0)
X       }
X       /*
X        * initialize the RTF file for standard paper (default)
X        */
X       call rtf_open(0)
X       set(title, concat("Descendents of ", fullname(indi, 0, 1, 128)))
X       call rtf_set_info(title, name(indi), author, author, created)
X       /*
X        * define default table size  of 6in with 4 columns of
X        * .125in, .375in, .375in, 5.125in
X        */
X       call rtf_set_row_width(4, 8640) /* 6in * 1440 */
X       call rtf_set_col_width(540)     /* .45in * 1440 */
X       call rtf_set_col_width(720)     /* .500in * 1440 */
X       call rtf_set_col_width(540)     /* .45in * 1440 */
X       /* want a footer with page number centered */
X       call rtf_footer(0, 2)
X       if (dosources) {
X               /* if doing sources, what footnote type */
X               call rtf_ftn_type(1, 0) /* everything at end */
X       }
X
X       /* add the first person to the list of people to process */
X       /* this primes the pump, so to speak */
X       call next_indi(indi)
X       enqueue(nextgen, indi)
X       if (titlepage) {
X               call dotitle(author, title)
X       }
X
X       /*
X        * all is setup to go down the descendency list.
X        * continue until all are individuals are processed.
X        * note that nextgen is the next generation to process
X        * and generation is the current one.
X        * both are queues so we keep order.  Basically, all
X        * children of the person being processed are appended
X        * to the end of the nextgen list.
X        */
X
X       while (or(length(generation), length(nextgen))) {
X               /*
X                * if no current generation but a nextgen exists,
X                * start a new paragraph with header for the Generation
X                * and make the nextgen the current generation
X                */
X               if (empty(generation)) {
X                       call rtf_para_indent(0, 0)
X                       call rtf_pstart(1)
X                       call rtf_para_keepnext()
X                       call rtf_hstart()
X                       set(curr_gen, add(curr_gen, 1))
X                       capitalize(ord(curr_gen))
X                       " Generation\n"
X                       call rtf_hend()
X                       call rtf_pend()
X                       set(generation, nextgen)
X                       list(nextgen)
X               }
X               /*
X                * the real work is done in out_register
X                * get the next person to process and then
X                * let out_register do the work.
X                */
X               set(indi, dequeue(generation))
X               call out_register(indi)
X       }
X       if (dosources) {
X               call dump_sources()
X       }
X       if (eq(donotes, 2)) {
X               /* end notes need to be dumped if they exist */
X               call endnotes()
X       }
X       call rtf_close()
X}
X
X/*
X * out_register( indi )
X *     outputs the standard register format for the
X *     individual.  Any children get added to nextgen
X *     if they have families.  Global variables are used
X *     to modify the exact output.
X */
Xproc out_register(indi)
X{
X       /*
X        * We always start a new paragraph with hanging indent for the number.
X        * It is then tagged to be kept intact to avoid splitting across pages.
X        * The indivual's number if found and printed and then the name
X        * is output followed by marriage(s), birth, death, etc.
X        */
X       call rtf_pstart(3)
X       call rtf_para_indent(neg(540), 540)
X       call rtf_para_keepintact()
X       d(inum(indi)) "."
X       call rtf_tab(0)
X       call rtf_bold(1)
X       fullname(indi, 0, 1, 128)
X       /* the individual's name is entered as a level 2 TOC header */
X       call rtf_toc_entry(2, fullname(indi, 0, 1, 128))
X       call rtf_bold(0)
X       if (doindex) {
X               /*
X                * optional indexing, main entry is bold
X                * It would be nice to have index same text
X                * as the output name but the format is different.
X                * Need to find a better way to tie together so edit
X                * will do the right thing.
X                */
X               rtf_index(surname(indi), givens(indi), 1)
X       }
X       /*
X        * it is important to not print duplicate marriages since in some
X        * families this can lead to excessive information.  In my own,
X        * there were 5 children of one ancestor married 5 children of
X        * another ancestor.  Over seven generations there have been
X        * additional crossings of the lines and a non-pruned tree is HUGE
X        *
X        * There are two types of pruning of this type that need to be
X        * considered.  The first is the simple case of a single marriage
X        * that is duplicated.  It can be handled with a simple reference
X        * to the first occurrence. The second type is more complex where
X        * there are multiple marriages.  Some of the marriages may be
X        * duplicates and need to be pruned, but some may be ones that
X        * haven't been seen yet.  This occurs when person A marries person B.
X        * The implication that B is married to A.  If B is also married to C
X        * the multiple case occurs.  In this case if B is seen as a child
X        * and the family info is about to be output, the marriage to A is
X        * a duplicate but the one to C is not.
X        */
X       if (check_marriages(indi)) {
X               /*
X                * duplicate marriages (common ancestors)
X                * are not duplicated but referred to the only
X                * instance.  If there were multiple marriages,
X                * then the duplicates can be referred to but the
X                * non-duplicate ones need expansion.
X                */
X               call rtf_italic(1)
X               set(prev, prevmarr(indi))
X               "(See marriage to "
X               set(f, getel(prev_fam_list, prev))
X               if (male(indi)) { set(s, wife(f)) }
X               else            { set(s, husband(f)) }
X               fullname(s, 0, 1, 128)
X               if (and(doindex, surname(s))) {
X                       rtf_index(surname(s), givens(s), 2)
X               }
X               ", number " prefix d(inum(s)) ")"
X               call rtf_italic(0)
X               call rtf_para_space(0, 120)
X               call rtf_pend()
X       } else {
X               /* not a complete duplicate so generate lots of text */
X               call rtf_para_keepnext()
X               if(e, birth(indi)) {
X                       " b. " long(e)
X                       if (dosources) {
X                               call do_sources(e)
X                       }
X               }
X               /*
X                * this is an attempt to track duplicate marriages.
X                * It needs to be looked at more carefully.
X                */
X               set(nmarr, nfamilies(indi))
X               /*
X                * run through all of this person's families
X                */
X               families (indi, famvar, spvar, cnt) {
X                  if (spvar) {
X                       set(prev, check_prev(famvar))
X                       if (not(prev)) {
X                               /* save for future reference */
X                               enqueue(prev_fam_list, famvar)
X                       }
X                       /*
X                        * basic format of marriage is
X                        * m. [date][[,] place] [(mnum)] spouse
X                        * [b. [date][, place]]
X                        * ([daughter|son] of spouse's parents)
X                        * [d. [date][, place]] [bur. [date][, place]].
X                        */
X                       /* If first spouse, use a ';' but ',' for rest */
X                       if (eq(1, cnt)) {
X                               "; m."
X                       } elsif (ne(0, cnt)) {
X                               ", m."
X                       }
X                       if (not(prev)) {
X                               if (e, marriage(famvar)) {
X                                       " " long(e)
X                                       if (dosources) {
X                                               call do_sources(e)
X                                       }
X                                       ","
X                               }
X                       }
X                       if (gt(nmarr, 1)) {
X                               " (" d(cnt) ")"
X                       }
X                       if (not(prev)) {
X                               " " fullname(spvar, 0, 1, 128)
X                               if (and(doindex, surname(spvar))) {
X                                       rtf_index(surname(spvar),
X                                       givens(spvar), 2)
X                               }
X                               set(items, 0)
X                               if (e, birth(spvar)) {
X                                       " b. " long(e)
X                                       if (dosources) {
X                                               call do_sources(e)
X                                       }
X                                       set(items, 1)
X                               }
X                               /*
X                                * we know parents so give a referral.
X                                * in a future version, this should be updated
X                                * to determine if spouses had common ancestor
X                                * and give the family number cross-reference.
X                                * This would apply to my own genealogy.
X                                */
X                               if (f, parents(spvar)) {
X                                       call rtf_italic(1)
X                                       if (male(spvar)) {
X                                               " (son of "
X                                       } else {
X                                               " (daughter of "
X                                       }
X                                       set(j, "")
X                                       if (f, father(spvar)) {
X                                               set(j, " and ")
X                                               fullname(f, 0, 1, 128)
X                                       }
X                                       if (f, mother(spvar)) {
X                                               j fullname(f, 0, 1, 128)
X                                       }
X                                       ")"
X                                       call rtf_italic(0)
X
X                                       /* spouse's death info */
X                                       if (e, death(spvar)) {
X                                               if (eq(items, 1)) {
X                                                       ", d. "
X                                               } else {
X                                                       " d. "
X                                               }
X                                               long(e)
X                                               if (dosources) {
X                                                       call do_sources(e)
X                                               }
X                                               set(items, 1)
X                                       }
X
X                                       /* spouse's burial info */
X                                       if (e, burial(spvar)) {
X                                               if (eq(1, items)) {
X                                                       ", bur. "
X                                               } else {
X                                                       " bur. "
X                                               }
X                                               long(e)
X                                               if (dosources) {
X                                                       call do_sources(e)
X                                               }
X                                               set(items, 1)
X                                       }
X                               }
X                       } else {
X                               fullname(spvar, 0, 1, 128)
X                               call rtf_italic(1)
X                               " (see marriage to number " d(inum(spvar))
X                               ")"
X                               call rtf_italic(0)
X                       }
X                   }
X               }
X               if (gt(cnt,0)) {
X                       ".\n"
X               }
X               /* indi's remaining information */
X               if (e, death(indi)) {
X                       " " givens(indi) " died " long(e)
X                       if (dosources) {
X                               call do_sources(e)
X                       }
X                       if (e, burial(indi)) {
X                               " and was buried " long(e)
X                               if (dosources) {
X                                       call do_sources(e)
X                               }
X                       }
X                       ".\n"
X               } elsif (e, burial(indi)) {
X                       " " givens(indi) " was buried " long(e)
X                       if (dosources) {
X                               call do_sources(e)
X                       }
X                       ".\n"
X               }
X               /*
X                * all occupations are given if any are found.
X                */
X               if (occupation) {
X                       call do_occupation(indi)
X               }
X               /* if doing notes, make sure we get them now */
X               if (donotes) {
X                       call do_notes(indi, donotes, 0)
X                       families(indi, famvar, spvar, cnt) {
X                               if (spvar) {
X                                       call do_notes(spvar, donotes, 0)
X                               }
X                       }
X               }
X               /*
X                * now the children
X                * starting a table is a new paragraph.  Keep it all together
X                * and put in a label cell in first row.  Then dump
X                * each child into a row.
X                */
X               call rtf_tstart(4)
X               call rtf_para_keepnext()
X               if (or(eq(nmarr, 1), not(childby))) {
X                       call rtf_cstart()
X                       call rtf_cstart()
X                       call rtf_cstart()
X                       call rtf_cstart()
X                       " Children:"
X                       call rtf_cend()
X               }
X               set(numchildren, 1)
X               set(tsize, totalchildren(indi))
X               set(fcnt, 0)
X               families(indi, famvar, spvar, cnt) {
X                       /*
X                        * if childby is set, then put spouse info
X                        * out to identify which family children
X                        * came from.  Skip families with no children
X                        */
X                       if (and(childby, gt(nmarr, 1))) {
X                               if (not(nchildren(famvar))) {
X                                       continue()
X                               }
X                               incr(fcnt)
X                               if (gt(fcnt, 1)) {
X                                       call rtf_endrow()
X                                       call rtf_endrow()
X                               }
X                               call rtf_cstart()
X                               call rtf_cstart()
X                               call rtf_cstart()
X                               call rtf_cstart()
X                               " Children with "
X                               fullname(spvar, 0, 1, 128)
X                               ":"
X                               call rtf_cend()
X                       }
X                       children (famvar, ch, num) {
X                               /* want to know if this is someone to expand */
X                               set(ival, determine(ch, indi))
X                               call rtf_endrow()
X                               if (lt(numchildren, tsize)) {
X                                       call rtf_para_keepnext()
X                               }
X                               /* note that nothing goes in cell 1 */
X                               call rtf_cstart()
X                               /* start the cell where we do a number */
X                               call rtf_cstart()
X                               call rtf_para_rightjust()
X
X                               /* if the indi is non-zero, then tag it */
X                               if (ne(ival, 0)) {
X                                       person_prefix d(ival) "."
X                               }
X
X                               /* the roman numeral/child order cell */
X                               call rtf_cstart()
X                               call rtf_para_rightjust()
X                               roman(numchildren) "."
X
X                               /* the name and info cell */
X                               call rtf_cstart()
X                               call rtf_para_leftjust()
X                               fullname(ch, 0, 1, 128)
X                               if (doindex) {
X                                       rtf_index(surname(ch), givens(ch), 0)
X                               }
X
X                               /* we always give birth info */
X                               if (b, birth(ch)) {
X                                       if (gt(ival, 0)) {
X                                               if (strlen(date(b))) {
X                                                       " b. "
X                                                       date(b)
X                                               }
X                                       } else {
X                                               " b. "
X                                               long(b)
X                                               if (dosources) {
X                                                       call do_sources(e)
X                                               }
X                                       }
X                               }
X
X                               /*
X                                * if a non-expanded indi, give more info
X                                * such as death, marriages, etc.  If
X                                * expanded, don't since the full record
X                                * will contain it.
X                                */
X                               if (eq(ival, 0)) {
X                                       if (e, death(ch)) {
X                                               if (b) { "," }
X                                               " d. " long(e)
X                                               if (dosources) {
X                                                       call do_sources(e)
X                                               }
X                                       }
X                                       set(nsp, nfamilies(ch))
X                                       /* all known spouses */
X                                       spouses(ch, sp, fm, cnt) {
X                                               "; m. "
X                                               if (gt(nsp, 1)) {
X                                                       "(" d(cnt) ") "
X                                               }
X                                               if (e, marriage(fm)) {
X                                                       long(e)
X                                                       if (dosources) {
X                                                               call do_sources(e)
X                                                       }
X                                                       ", "
X                                               }
X                                               fullname(sp, 0, 1, 128)
X                                               if (doindex) {
X                                                       rtf_index(surname(sp),
X                                                               givens(sp), 2)
X                                               }
X                                       }
X                                       ". "
X                                       if (donotes) {
X                                               call do_notes(ch, donotes, 1)
X                                       }
X                               } else {
X                                       "."
X                               }
X                               call rtf_cend()
X                               incr(numchildren)
X                       }
X               }
X               call rtf_tend()
X               call rtf_pend()
X       }
X       call rtf_para_space(0, 0)
X}
X
X/*
X * next_indi(indi)
X *     find the next unique number for this individual
X *     the global curr_index keeps the current value
X *     the inum_set keeps track of the indi/number pairs
X */
Xproc next_indi(indi)
X{
X       set(curr_index, add(curr_index, 1))
X       addtoset(inum_set, indi, curr_index)
X}
X
X/*
X * inum(indi)
X *     find the unique number for this indi
X *     if there is one it is in inum_set
X *     zero is returned if there isn't a mapping
X */
Xfunc inum(indi)
X{
X       forindiset(inum_set, indvar, inumval, cnt) {
X               if (eq(indvar, indi)) {
X                       return (inumval)
X               }
X       }
X       return (0)
X}
X
X/*
X * find_fam(indi, spouse)
X *     find the family (fam) indi and spouse create
X */
Xfunc find_fam(indi, sps)
X{
X       spouses (indi, s, f, c) {
X               if (eq(sps, s)) {
X                       return (f)
X               }
X       }
X}
X
X/*
X * check_marriages(indi)
X *     check to see if an individual has any marriages and return
X *     the inum of the first spouse that has one
X */
Xfunc check_marriages(indi)
X{
X       set(res, 0)
X       set(notyet, 0)
X       families (indi, f, s, c) {
X               if (x, check_prev(f)) {
X                       incr(res)
X               } else {
X                       incr(notyet)
X               }
X       }
X       if (and(res, not(notyet))) {
X               return (1)
X       } else {
X               return (0)
X       }
X}
X
X/*
X * check_prev(fam)
X *     check to see if a previous marriage and return non-zero
X *     if there was one and zero if none.
X */
Xfunc check_prev(fam)
X{
X       forlist(prev_fam_list, f, cnt) {
X               if (eq(fam, f)) {
X                       return (cnt)
X               }
X       }
X       return (0)
X}
X
X/*
X * determine(indi, par)
X *     determine if the indi is one to expand.
X *     The par is the parent descended from so that
X *     female lines can be skipped if strictness is
X *     set.
X */
Xfunc determine(indi, par)
X{
X       if (and(eq(strictness, 2), female(indi))) {
X               /* strictest form doesn't follow female lines */
X               return (0)
X       }
X       if (and(eq(strictness, 1), female(par))) {
X               /* modified form gives one generation from a female line */
X               return (0)
X       }
X       set(nchil, 0)
X       families (indi, fm, sp, cnt) {
X               set(nchil, add(nchil, nchildren(fm)))
X       }
X       if (gt(nchil, 0)) {
X               enqueue(nextgen, indi)
X               call next_indi(indi)
X               return (inum(indi))
X       }
X       return (0)
X}
X
X/*
X * do_notes(indi, where, type)
X *     where is inline vs. end
X *     type is in or out of table
X */
Xproc do_notes(indi, where, type)
X{
X       /* where == 1 is inline */
X    if (eq(where, 1)) {
X       set(didpara, 0)
X       set(innote, 0)
X       set(root, inode(indi))
X       traverse(root, node, level) {
X               if (and(innote, le(level, innote))) {
X                       set(innote, 0)
X               }
X               if (eqstr(tag(node), "NOTE")) {
X                       if (not(type)) {
X                               call rtf_pstart(3)
X                       } else {
X                               call rtf_cpar()
X                       }
X                       set(innote, level)
X                       call fixstring(value(node))
X                       set(didpara, 1)
X               } elsif (eqstr(tag(node), "CONT")) {
X                       if (innote) {
X                               if (eq(0, strlen(value(node)))) {
X                                   if (not(type)) {
X                                       call rtf_pstart(3)
X                                   } else {
X                                       call rtf_cpar()
X                                   }
X                               } else {
X                                       " \n"
X                                       call fixstring(value(node))
X                               }
X                       }
X               }
X       }
X    } elsif (eq(where, 2)) {   /* where == 2 is at end */
X       set(found, 0)
X       set(tagprefix, 0)
X       set(root, inode(indi))
X       traverse(root, node, level) {
X               if (eqstr(tag(node), "NOTE")) {
X                       if (not(found)) {
X                               " ["
X                       } else {
X                               ", "
X                       }
X                       incr(found)
X                       if (not(tagprefix)) {
X                               set(tagprefix, tagname(indi))
X                       }
X                       tagprefix d(found)
X               }
X       }
X       if (found) {
X               "]"
X       }
X    }
X}
X
X/*
X * fixstring(str)
X *     fix the string to not break RTF output
X *     Any {, }, or \ characters must be escaped.
X *     Then output the string
X */
Xproc fixstring(str)
X{
X       if (i, index(str, "{", 1)) {
X               call fixstring(substring(str, 1, i))
X               "\\{"
X               incr(i)
X               call fixstring(substring(str, i, sub(strlen(str), i)))
X       } elsif (i, index(str, "}", 1)) {
X               call fixstring(substring(str, 1, i))
X               "\\}"
X               incr(i)
X               call fixstring(substring(str, i, sub(strlen(str), i)))
X       } elsif (i, index(str, "\\", 1)) {
X               call fixstring(substring(str, 1, i))
X               "\\\\"
X               incr(i)
X               call fixstring(substring(str, i, sub(strlen(str), i)))
X       } else {
X               str
X       }
X}
X
X/*
X * prevmarr(indi)
X *     determine if an indi had a previously output marriage.
X */
Xfunc prevmarr(indi)
X{
X       spouses (indi, s, f, c) {
X               forlist (prev_fam_list, fm, cnt) {
X                       if (eq(f, fm)) {
X                               return (cnt)
X                       }
X               }
X       }
X       return (0)
X}
X
X/*
X * dotitle(author, title)
X */
Xproc dotitle(author, title)
X{
X       "\\titlepg"
X       "\\pvmrg\\posy2880\\qc\\fs48 "
X               title
X               "\\line\\line "
X               "\\fs32 by\\line "
X               author
X       "\\par\\sect\\pgnrestart\n"
X}
X
X/*
X * tagname(indi)
X *     from an indi, create a unique tag to use for notes references
X *     for endnote form.
X */
Xfunc tagname(indi)
X{
X       list(parts)
X       /*
X        * the algorithm is:
X        *      first 3 letters of surname
X        *      first letter of first and any middle name
X        *      if conflict, try adding "a", "b", etc. until unique.
X        */
X       extractnames(inode(indi), parts, nparts, surpart)
X       set(surnm, substring(getel(parts, surpart), 1, 3))
X       set(firstp, substring(getel(parts, 1), 1, 1))
X       if (gt(nparts, 2)) {
X               set(midp, substring(getel(parts, 2), 1, 1))
X               if (not(strcmp(midp, "\""))) {
X                       set(midp, substring(midp, 2, 2))
X               }
X       } else {
X               set(midp, "")
X       }
X       set(tagvar, concat(surnm, firstp, midp))
X       set(suffix, "")
X       set(v, 0)
X       while (lookup(endtags, concat(tagvar, suffix))) {
X               incr(v)
X               set(suffix, substring("abcdefghijklmnopqrstuvwxyz",
X                               v, v))
X       }
X       insert(endtags, tagvar, indi)
X       call sorttag(tagvar)
X       set(tagvar, concat(tagvar, suffix))
X       return (tagvar)
X}
X
X/*
X * sorttag(str)
X *     do an insertion sort of str into the taglist list of notes
X */
Xproc sorttag(str)
X{
X       list(tmp)
X       set(done, 0)
X       set(any, 0)
X       while (l, dequeue(taglist)) {
X           set(any, 1)
X           if (not(done)) {
X               set(r, strcmp(str, l))
X               if (le(r, 0)) {
X                       set(done, 1)
X                       enqueue(tmp, str)
X               }
X               if (ne(r, 0)) {
X                       enqueue(tmp, l)
X               }
X           } else {
X               enqueue(tmp, l)
X           }
X       }
X
X       if (or(not(any), not(done))) {
X               enqueue(tmp, str)
X               set(any, 1)
X       }
X
X       /* set to null so we can copy the new list */
X       list(taglist)
X       if (any) {
X               while (l, dequeue(tmp)) {
X                       enqueue(taglist, l)
X               }
X       }
X}
X
X/*
X * endnotes()
X *     at end, dump the endnotes in a reasonable format
X */
Xproc endnotes()
X{
X       call rtf_newpage()
X       call rtf_para_indent(0, 0)
X       call rtf_pstart(1)
X       call rtf_hstart()
X       "Notes"
X       call rtf_hend()
X       call rtf_pend()
X       while (l, dequeue(taglist)) {
X               set(indi, lookup(endtags, l))
X               if (indi) {
X                       call dumpnote(indi, l)
X               }
X       }
X}
X
X/*
X * dumpnote(indi, tagstr)
X *     dump the notes for this indi, using tagstr as the prefix
X */
Xproc dumpnote(indi, tagstr)
X{
X       set(didpara, 0)
X       set(innote, 0)
X       set(root, inode(indi))
X       set(which, 0)
X       traverse(root, node, level) {
X               if (and(innote, le(level, innote))) {
X                       set(innote, 0)
X               }
X               if (nestr(tag(node), "NOTE")) {
X                       call rtf_pstart(3)
X                       call rtf_para_indent(neg(1440), 1440)
X                       incr(which)
X                       set(innote, level)
X                       tagstr d(which)
X                       rtf_tab(0)
X                       value(node)
X                       set(didpara, 1)
X               } elsif (nestr(tag(node), "CONT")) {
X                       if (innote) {
X                               if (eq(0, strlen(value(node)))) {
X                                       call rtf_pstart(3)
X                               } else {
X                                       " \n" value(node)
X                               }
X                       }
X               }
X       }
X}
X
X/*
X * totalchildren(indi)
X *     count all the children this indi had
X */
Xfunc totalchildren(indi)
X{
X       set(total, 0)
X       families (indi, fam, sp, cnt) {
X               set(total, add(total, nchildren(fam)))
X       }
X       return (total)
X}
X
X/*
X * do_sources(e)
X *     find all the sources associated with the event
X *     and create the footnote reference.  If dosources is
X *     greater than 1, just gather the footnotes to stick at
X *     the end of family rather than in-line for each event
X *     {mode 2 not implemented yet}
X */
Xproc do_sources(e)
X{
X       set(evlist, sources(e))
X       list(taglist)
X       while (s, dequeue(evlist)) {
X               set(srcvar, fmt_source(s))
X               set(taglist, source_process(srcvar))
X       }
X       if (not(empty(taglist))) {
X               call rtf_super(1)
X               set(pre, "")
X               forlist(taglist, var, cnt) {
X                       pre d(var)
X                       set(pre, ", ")
X               }
X               call rtf_super(0)
X       }
X}
X
X/*
X * fmt_source(s)
X *     for a source node, traverse it and put into a normalized
X *     reference/footnote format.  New forms should be added as
X *     necessary since there are lots of possibilities.
X */
Xfunc fmt_source(s)
X{
X       set(prefix, "")
X       set(cont, "")
X       set(result, "")
X       set(title,0)
X       set(sour, 0)
X       set(dt, 0)
X       set(text, 0)
X       set(publ, 0)
X       set(page, 0)
X       traverse (s, node, l) {
X               if (gt(l, 2)) {
X                       continue()
X               }
X               if (reference(value(node))) {
X                       set(indresult, fmt_source(dereference(value(node))))
X               } else {
X                       if (eq(l, 0)) {
X                               continue()
X                       } elsif (eqstr(tag(node), "SOUR")) {
X                               set(sour, text_node(node))
X                       } elsif (eqstr(tag(node), "TEXT")) {
X                               set(text, text_node(node))
X                       } elsif (eqstr(tag(node), "DATE")) {
X                               set(dt, date(node))
X                       } elsif (eqstr(tag(node), "TITL")) {
X                               set(title, text_node(node))
X                       } elsif (eqstr(tag(node), "PAGE")) {
X                               set(page, concat("page ", value(node)))
X                       }
X               }
X       }
X       set(result, "")
X       if (indresult) {
X               set(result, indresult)
X               set(prefix, ", ")
X       }
X       if (title) {
X               set(result, concat(result, prefix, title))
X               set(prefix, ", ")
X       }
X       if (sour) {
X               set(result, concat(result, prefix, sour))
X               set(prefix, ", ")
X       }
X       if (dt) {
X               set(result, concat(result, prefix, dt))
X               set(prefix, ", ")
X       }
X       if (text) {
X               set(result, concat(result, prefix, text))
X               set(prefix, ", ")
X       }
X       if (publ) {
X               set(result, concat(result, prefix, publ))
X               set(prefix, ", ")
X       }
X       if (page) {
X               set(result, concat(result, prefix, page))
X               set(prefix, ", ")
X       }
X       return (result)
X}
X
X/*
X * sources(e)
X *     for an event, look for all source nodes and make a list
X *     to return.
X */
Xfunc sources(ev)
X{
X       list(evs)
X       if (not(ev)) {
X               return (evs)
X       }
X       set(cnt, 0)
X       traverse(ev, node, lev) {
X               if (eqstr(tag(node), "SOUR"))  {
X                       enqueue(evs, node)
X                       incr(cnt)
X               }
X       }
X       return (evs)
X}
X
X/*
X * source_process(src)
X *     look for the string src in the list of known sources
X *     if it exists, use that index.  If it doesn't add to list
X *     and use the new index.  Then remove duplicate entries
X *     and ultimately return the list of uniqe references.
X */
Xfunc source_process(src)
X{
X       list(taglist)
X       set(found,0)
X       forlist(all_sources, str, cnt) {
X               if (eqstr(str, src)) {
X                       set(found, cnt)
X                       break()
X               }
X       }
X       if (not(found)) {
X               enqueue(all_sources, src)
X               incr(cnt)
X               set(taglist, addtolist(taglist, cnt))
X       } else {
X               set(taglist, addtolist(taglist, found))
X       }
X       return (taglist)
X}
X
X/*
X * addtolist(lst, num)
X *     add the value "num" to the list "lst" if
X *     it isn't already there.
X */
Xfunc addtolist(lst, num)
X{
X       set(found, 0)
X       list(newlist)
X       forlist(lst, val, cnt) {
X          if (not(found)) {
X               if (eq(val, num)) {
X                       return (lst)    /* no change - a dup */
X               } elsif (gt(val, num)) {
X                       set(found, 1)
X                       enqueue(newlist, num)
X                       enqueue(newlist, val)
X               }
X          } else {
X               enqueue(newlist, val)
X          }
X       }
X       if (not(found)) {
X               enqueue(newlist, num)
X       }
X       return (newlist)
X}
X/*
X * dump_sources()
X *     dump the entire list of reference sources with proper tags.
X */
Xproc dump_sources()
X{
X       if (not(empty(all_sources))) {
X               call rtf_pend()
X               call rtf_newpage()
X               call rtf_para_indent(0, 0)
X               call rtf_pstart(1)
X               call rtf_hstart()
X                       "References"
X               call rtf_hend()
X               call rtf_pend()
X               forlist(all_sources, src, num) {
X                       call rtf_pstart(3)
X                       call rtf_para_indent(neg(540), 540)
X                       d(num)
X                       call rtf_tab(0)
X                       src
X                       call rtf_pend()
X               }
X       }
X}
X
X/*
X * text_node(node)
X *     convert a text type node (TEXT or SOUR) into a long
X *     string with CONT entries separated by space.
X */
Xfunc text_node(node)
X{
X       set(result, "")
X       set(prefix, "")
X       traverse(node, n, l) {
X               set(result, concat(result, prefix, value(n)))
X               set(prefix, " ")
X       }
X       return (result)
X}
X
X/*
X * do_occupation(ind)
X *     print out occupation(s) of the individual in
X *     a meaningful form.
X */
Xproc do_occupation(indi)
X{
X       list(occu)
X       set(count, 0)
X       traverse (inode(indi), node, lev) {
X               if (eqstr(tag(node), "OCCU")) {
X                       /* have an occupation */
X                       enqueue(occu, value(node))
X                       incr(count)
X               }
X       }
X       if (not(empty(occu))) {
X               " "
X               pn(indi, 0)
X               " was a "
X               set(sep, "")
X               forlist(occu, item, cnt) {
X                       item sep
X                       if (eq(count, add(cnt, 1))) {
X                               set(sep, ", and ")
X                       } else {
X                               set(sep, ", ")
X                       }
X               }
X               ". "
X       }
X}
!EOF!
mkdir -p rtflib
sed -e 's/^X//' <<'!EOF!' >>rtflib/rtflib
X/*
X * RTF functions for implementing RTF output
X *     this allows generating Word or other
X *     documents directly.
X *     Written by Doug McCallum
X *     Version 1.1
X */
Xglobal(rtf_termstring)
Xglobal(rtf_tcols)
Xglobal(rtf_row_width)
Xglobal(rtf_row_left)
Xglobal(rtf_set_cols)
Xglobal(rtf_col_sizes)
Xglobal(rtf_pointsize)
Xglobal(rtf_pstate)
Xglobal(rtf_curr_indent)
Xglobal(rtf_tstate)
Xglobal(rtf_cstate)
Xglobal(rtf_ccol)
Xglobal(twips)          /* 20 points per inch */
Xglobal(rtf_bspace)
Xglobal(rtf_aspace)
Xglobal(rtf_ftn_last_tag)       /* last footnote tag */
Xglobal(rtf_ftn_state)
X
X/*
X * Initialize the RTF state machine and variables
X */
X
X/*
X * rtf_init(font)
X *     initialize the RTF state.
X *     set font as the default font to use (not working yet)
X */
Xproc rtf_init(font)
X{
X       set(twips, 1440)
X       list(rtf_pointsize)
X       setel(rtf_pointsize, 1, 24)     /* style 1 at 12pt */
X       setel(rtf_pointsize, 2, 18)     /* style 2 at 9pt */
X       setel(rtf_pointsize, 3, 20)     /* style 3 at 10pt */
X       set(rtf_curr_indent, 0)         /* no paragraph indent */
X
X       /* some table state */
X       set(rtf_ccol, 0)
X       set(rtf_pstate, 0)
X       set(rtf_cstate, 0)
X       list(rtf_col_sizes)
X       set(rtf_set_cols, 0)
X
X       /* all RTF files need this */
X       "{\\rtf1\\ansi\\deff2{\\fonttbl{\\f10\\fnil "
X       font
X       ";}}\n"
X       "{\\stylesheet{\\fs20\\basedon222\\snext0\\f10 Normal;}\n"
X       "{\\s1\\fs24\\basedon0\\snext3\\f10\\b\\sb240\\sa60 Heading;}\n"
X       "{\\s2\\basedon1\\fs20\\f10\\up Footnote;}\n"
X       "{\\s3\\basedon222\\snext3\\f10\\fs20\\sb120\\sa10 Text;}\n"
X       /* you can add new styles here */
X       "}\n"
X       set(rtf_termstring, "\n\\par}\n")
X       monthformat(4)
X       dayformat(0)
X       dateformat(5)   /* nn-MON-yyyy */
X}
X
X/*
X * rtf_open(file)
X *     just do some setup.  If "file" defined, open it.
X */
Xproc rtf_open(file)
X{
X       if (file) {
X               newfile(file, 0)
X       }
X       call rtf_init("Palatino")
X}
X
X/*
X * rtf_close()
X *     closes open tables and paragraphs then
X *     adds the closing bracket for the document
X */
Xproc rtf_close()
X{
X       call rtf_tend()
X       call rtf_pend()
X       rtf_termstring
X}
X
X/*
X * rtf_set_page_size(height, width, left, right, top, bot)
X *     set the page size if non-standard size is desired.
X *     height and width are paper size
X *     left, right, top and bot are the margin sizes
X *     sizes in twips (20pts/inch :: 1440 == 1inch)
X */
Xproc rtf_set_page_size(height, width, left, right, top, bot)
X{
X       "\\paperw" d(width)
X       "\\paperh" d(height)
X       "\\margl"  d(left)
X       "\\margr"  d(right)
X       "\\margt"  d(top)
X       "\\margb"  d(bottom) nl()
X}
X
X/*
X * rtf_newpage()
X *     insert a forced pagebreak at this point
X */
Xproc rtf_newpage()
X{
X       "\\page "
X}
X
X/*
X * paragraph functions
X *     there are a number of options here
X */
X
X/*
X * rtf_pstart(type)
X *     start a new paragraph with the style selected
X */
Xproc rtf_pstart(type)
X{
X       /* if in a paragraph, end it */
X       if (eq(rtf_pstate, 1)) {
X               call rtf_pend()
X       }
X       set(rtf_pstate, 1)
X       "\\pard {\\s" d(type)
X       if (ps, getel(rtf_pointsize, type)) {
X               "\\fs" d(ps) " "
X       }
X
X       call rtf_para_space(rtf_bspace, rtf_aspace)
X
X       if (gt(rtf_curr_indent, 0)) {
X               /* "next" paragraph */
X               call rtf_para_indent(0, rtf_curr_indent)
X       }
X}
X
X/*
X * rtf_pend()
X *     end the current paragraph
X *     this is for completeness but a new pstart will do it
X *     so it is optional
X */
Xproc rtf_pend()
X{
X       if (eq(1, rtf_pstate)) {
X               "\\par}\n"
X               set(rtf_pstate, 0)
X       }
X}
X
X/*
X * rtf_para_indent(first, all)
X *     tagged/indented paragraphs
X *     should be called right after a rtf_pstart()
X *     to select the indent of the first and remaining lines
X *     Note that the first line is also indented the same as
X *     all but can have more or less indent applied
X *     typical is to have first be the neg of the all
X *     a tab will make a hanging indent in that case
X */
Xproc rtf_para_indent(first, all)
X{
X       if (or(gt(first, 0), gt(all, 0))) {
X               "\\li" d(all) "\\fi"
X               d(first)
X               "\\tx" d(all) " "
X       }
X       set(rtf_curr_indent, all)
X}
X
X/*
X * rtf_para_space(before, after)
X *     amount of white space before and after a paragraph
X */
Xproc rtf_para_space(before, after)
X{
X    if (rtf_pstate) {
X       if (ne(before, 0)) {
X               "\\sb" d(before)
X       } else {
X               "\\sb" d(mul(getel(rtf_pointsize, 3), 5))
X       }
X       if (ne(after, 0)) {
X               "\\sa" d(after)
X       }
X    }
X    set(rtf_bspace, before)
X    set(rtf_aspace, after)
X}
X
X/*
X * rtf_para_keepnext()
X *     causes current paragraph to be kept on same page as
X *     the next paragraph
X */
Xproc rtf_para_keepnext()
X{
X       "\\keepn "
X}
X
X/*
X * rtf_para_centered()
X *     make the current paragraph text be centered
X */
Xproc rtf_para_centered()
X{
X       "\\qc "
X}
X
X/*
X * rtf_para_leftjust()
X *     make the current paragraph text left justified
X */
Xproc rtf_para_leftjust()
X{
X       "\\ql "
X}
X
X/*
X * rtf_para_rightjust()
X *     make the current paragraph text right justified
X */
Xproc rtf_para_rightjust()
X{
X       "\\qr "
X}
X
X/*
X * rtf_para_keepintact()
X *     don't try to break this paragraph across pages
X */
Xproc rtf_para_keepintact()
X{
X       "\\keep "
X}
X
X/*
X * rtf_set_info(title, subject, author, operator, created)
X *     set the file's info section to have the values specified
X */
Xproc rtf_set_info(title, subject, author, operator, created)
X{
X       "{\\info\n"
X       if (title) {
X               "{\\title " title "}\n"
X       }
X       if (subject) {
X               "{\\subject " subject " }\n"
X       }
X       if (author) {
X               "{\\author " author "}\n"
X       }
X       if (operator) {
X               "{\\operator " operator "}\n"
X       }
X       if (created) {
X
X               set(yr, save(substring(created, 1, 4)))
X               set(mo, save(substring(created, 6, 7)))
X               set(dy, save(substring(created, 9, 10)))
X               "{\\creatim\\yr" yr
X                            "\\mo" mo
X                            "\\dy" dy "}\n"
X       }
X       "{\\doccomm Document generated from LifeLines "
X               version()
X               " database "
X               database() "by register-rtf 1.1.}\n"
X       "}\n"
X}
X
X/*
X * table functions
X *     there are a number related to rows and cells
X */
X
X/*
X * rtf_set_row_width(cols, wid)
X *     set the table row width and number of columns to expect
X */
Xproc rtf_set_row_width(cols, wid)
X{
X       set(rtf_tcols, cols)
X       set(rtf_row_width, sub(wid, mul(sub(rtf_tcols, 1), 108)))
X       set(rtf_row_left, rtf_row_width)
X}
X
X/*
X * rtf_set_col_width(wid)
X *     set the current column width
X *     called once for each column defined
X */
Xproc rtf_set_col_width(wid)
X{
X    if (lt(rtf_set_cols, rtf_tcols)) {
X       setel(rtf_col_sizes, one(rtf_set_cols), wid)
X       incr(rtf_set_cols)
X       set(rtf_row_left, sub(rtf_row_left, wid))
X       set(i, rtf_set_cols)
X       while (lt(i, rtf_tcols)) {
X               setel(rtf_col_sizes, one(i),
X                       div(rtf_row_left, sub(rtf_tcols, rtf_set_cols)))
X               incr(i)
X       }
X    }
X}
X
X/*
X * rtf_tstart(cells)
X *     start table with cells per row
X */
Xproc rtf_tstart(cells)
X{
X       if (eq(rtf_tstate, 1)) {
X               call rtf_tend()
X       }
X       call rtf_pend()
X       "\\trowd "
X       set(rtf_tstate, 1)
X       "\\trgaph" d(108)
X       "\\trleft" d(neg(108))
X       set(i, 0)
X       set(cumwid, 0)
X       while (lt(i, cells)) {
X               if (gt(i, 0)) {
X                       set(gap, 108)
X               } else {
X                       set(gap, 0)
X               }
X               set(gap, add(gap, getel(rtf_col_sizes, one(i))))
X               set(cumwid, add(cumwid, gap))
X               "\\cellx" d(cumwid) "\n"
X               set(i, add(i, 1))
X       }
X       set(rtf_tcols, cells)
X       "\\pard\\plain\\s3\\intbl "
X}
X
X/*
X * rtf_tend()
X *     end table
X */
Xproc rtf_tend()
X{
X       if (rtf_tstate) {
X               while (lt(rtf_ccol, rtf_tcols)) {
X                       rtf_cend()
X               }
X               "\\intbl\\row\\pard\\s3 "
X               set(rtf_tstate, 0)
X       }
X}
X
X/*
X * rtf_cstart()
X *     start a cell in a table
X */
Xproc rtf_cstart()
X{
X       if (rtf_cstate) {
X               call rtf_cend()
X       }
X       call rtf_pend()
X       "\\fs" d(getel(rtf_pointsize, 3))
X       set(rtf_cstate, 1)
X}
X
X/*
X * rtf_cend()
X *     end a cell
X */
Xproc rtf_cend()
X{
X       if (or(rtf_cstate, rtf_tstate)) {
X               set(rtf_cstate, 0)
X               "\n\\cell "
X               set(rtf_ccol, add(rtf_ccol, 1))
X       }
X}
X
X/*
X * rtf_cpar()
X *     insert a paragraph break inside a cell
X */
Xproc rtf_cpar()
X{
X       "\\par "
X}
X
X/*
X * rtf_endrow()
X *     end a table row and get ready for next one
X */
Xproc rtf_endrow()
X{
X       if (rtf_tstate) {
X               while (lt(rtf_ccol, rtf_tcols)) {
X                       call rtf_cend()
X               }
X               "\\pard\\s3\\inttbl\\row "
X               set(rtf_tstate, 0)
X               call rtf_tstart(rtf_tcols)
X               set(rtf_ccol, 0)
X       }
X}
X
X/* heading handling */
X
X/*
X * rtf_hstart()
X *     start a heading
X */
Xproc rtf_hstart()
X{
X       "\\sb" d(mul(getel(rtf_pointsize, 1), 12))
X       "\\sa" d(mul(getel(rtf_pointsize, 1), 6)) " "
X       "{\\tc\\s1\\b "
X}
X
X/*
X * rtf_hend()
X *     end a heading
X */
Xproc rtf_hend()
X{
X       "\\b0}\n"
X}
X
X/*
X * rtf_index(key, subkey, type)
X *     create an index entry
X *     if subkey is defined, a two level index is
X *     created.  e.g.
X *     McCallum
X *             Charles         1
X *     the type is plain = 0, bold = 1 and italic = 2
X */
Xfunc rtf_index(key, subkey, type)
X{
X       if (eq(type, 0)) {
X               set(var, "}}\n")
X       } elsif (eq(type, 1)) {
X               set(var, "\\bxe}}\n")
X       } elsif (eq(type, 2)) {
X               set(var, "\\ixe}}\n")
X       }
X       set(ind, concat("{\\xe{\\v ", key))
X       if (subkey) {
X               set(inds, concat("\\:", subkey))
X       } else {
X               set(inds, "")
X       }
X       set(indy, concat(ind, inds, var))
X       return (indy)
X}
X
X/*
X * rtf_header(type, page)
X *     create a header entry (as in header/footer)
X *     type is all pages = 0, left = 1 and right = 2
X *     page is where to place the page number
X *     no page number = 0, left side = 1, center = 2 and right = 3
X */
Xproc rtf_header(type, page)
X{
X       if (eq(page, 0)) {
X               set(pstr, "")
X               set(pastr, "")
X       } elsif (eq(page, 1)) {
X               set(pastr, "\\ql")
X               set(pstr, "\\chpgn")
X       } elsif (eq(page, 2)) {
X               set(pastr, "\\qc")
X               set(pstr, "\\chpgn")
X       } elsif (eq(page, 3)) {
X               set(pastr, "\\qr")
X               set(pstr, "\\chpgn")
X       }
X       if (eq(type, 0)) {
X               set(hstr, "\\header")
X       } elsif (eq(type, 1)) {
X               set(hstr, "\\headerl")
X       } elsif (eq(type, 2)) {
X               set(hstr, "\\headerr")
X       }
X       "{" hstr "\\pard\\plain\\s3" pastr "{\\plain " pstr "}\\par}\n"
X}
X/*
X * rtf_footer(type, page)
X *     creates a footer.
X *     see rtf_header for details
X */
Xproc rtf_footer(type, page)
X{
X       if (eq(page, 0)) {
X               set(pstr, "")
X               set(pastr, "")
X       } elsif (eq(page, 1)) {
X               set(pastr, "\\ql")
X               set(pstr, "\\chpgn")
X       } elsif (eq(page, 2)) {
X               set(pastr, "\\qc")
X               set(pstr, "\\chpgn")
X       } elsif (eq(page, 3)) {
X               set(pastr, "\\qr")
X               set(pstr, "\\chpgn")
X       }
X       if (eq(type, 0)) {
X               set(hstr, "\\footer")
X       } elsif (eq(type, 1)) {
X               set(hstr, "\\footerl")
X       } elsif (eq(type, 2)) {
X               set(hstr, "\\footerr")
X       }
X       "{" hstr "\\pard\\plain\\s3" pastr "{\\plain " pstr "}\\par}\n"
X}
X
X/*
X * rtf_ftn_type(type, postype)
X *     define the type(s) of footnotes/endnotes to use
X */
Xproc rtf_ftn_type(type, postype)
X{
X       "\\fet" d(type)
X       if (eq(type, 1)) {
X               if (eq(postype, 0)) {
X                       "\\enddoc\\aenddoc"
X               } elsif (eq(postype, 1)) {
X                       "\\endnotes\\aendnotes"
X               }
X       } elsif (eq(type, 2)) {
X               if (eq(postype, 0)) {
X                       "\\aenddoc"
X               } elsif (eq(postype, 1)) {
X                       "\\aendnotes"
X               }
X       }
X       "\n"
X}
X
X/*
X * rtf_ftn_tag(tag)
X *     if tag is not null, it is a user defined tag
X *     if null, do an automatic generation of the tag
X *     In all cases, output it superscripted
X */
Xproc rtf_ftn_tag(tag)
X{
X       if (tag) {
X               set(rtf_ftn_last_tag, tag)
X       } else {
X               set(rtf_ftn_last_tag, "\\chftn")
X       }
X       "{\\up6 " rtf_ftn_last_tag "}"
X}
X
X/*
X * rtf_ftn_start(tag)
X *     start a possibly tagged footnote
X *     must be closed with rtf_ftn_end()
X */
Xproc rtf_ftn_start(tag)
X{
X       if (rtf_ftn_state) {
X               call rtf_ftn_end()
X       }
X       call rtf_ftn_tag(tag)
X       "{\*\footnote\\pard\\plain\\s3\\fs"
X       d(getel(rtf_pointsize, 3))
X       "\\li-540\\fi540\\tx540 "
X       rtf_ftn_last_tag
X       "\tab "
X       set(rtf_ftn_state, 1)
X}
X/*
X * rtf_ftn_end()
X *     close an open footnote.
X */
Xproc rtf_ftn_end()
X{
X       if (rtf_ftn_state) {
X               "}\n"
X               set(rtf_ftn_state, 0)
X       }
X}
X
X/*
X * rtf_tab(type)
X *     issue a tab of appropriate type
X */
Xproc rtf_tab(type)
X{
X       if (eq(type, 0)) {
X               "\\tab "
X       } elsif (eq(type, 1)) {
X               "\\tqr "
X       } elsif (eq(type, 2)) {
X               "\\tqc "
X       }
X}
X
X/*
X * rtf_bold(on)
X *     turn bold on/off
X */
Xproc rtf_bold(on)
X{
X       if (on) {
X               "\\b "
X       } else {
X               "\\b0 "
X       }
X}
X
X/*
X * rtf_italic(on)
X *     turn italic on/off
X */
Xproc rtf_italic(on)
X{
X       if (on) {
X               "\\i "
X       } else {
X               "\\i0 "
X       }
X}
X
X/*
X * rtf_underline(type)
X *     turn underline on/off
X *     if type == 0 off
X *     1 == continuous, 2 == double, 3 == word, 4 == dotted
X */
Xproc rtf_underline(type)
X{
X       if (type) {
X               if (eq(type, 1)) { "\\ul " }
X               elsif (eq(type, 2)) { "\\uldb " }
X               elsif (eq(type, 3)) { "\\ulw " }
X               elsif (eq(type, 4)) { "\\uld " }
X       } else {
X               "\\ul0 "
X       }
X}
X
X/*
X * rtf_super(on)
X *     turn superscript on/off
X */
Xproc rtf_super(on)
X{
X       if (on) {
X               "{\\up6"
X               if (ps, getel(rtf_pointsize, 3)) {
X                       set(ps, sub(ps, 3))
X                       "\\fs" d(ps)
X               }
X               " "
X       } else {
X               "}"
X       }
X}
X
X/*
X * rtf_toc_entry(level, text)
X *     enter text as a Table of Contents entry at level
X */
Xproc rtf_toc_entry(level, text)
X{
X       "{\\tc\\tcl" d(level)
X       "{\\v " text "}}"
X}
X
X/*
X * one(val)
X *     similar to incr() but returns the new value
X */
Xfunc one(val)
X{
X       return (add(val, 1))
X}
!EOF!