{  4/8/87  20:47   newest}

{!  If Vax.}
{%include "sm:consts.inc"}
{%include "sm:formats.inc"}
{%include "sm:persons.inc"}
{%include "sm:utils.inc"}
{%include "sm:vtlib.inc"}
!

%begin

! If APM.
%include "sm:consts.inc"
%include "sm:formats.inc"
%include "sm:menus.inc"
%include "sm:persons.inc"
%include "sm:utils.inc"
%include "inc:vtlib.imp"
%include "inc:dict.imp"
%include "inc:fs.imp"
%include "inc:fsutil.imp"
%include "ie:ie.inc"

%externalroutinespec run program(%string(255) file)
%externalroutinespec reset terminal %alias "IE_RESET_TERMINAL"
%externalroutinespec set up terminal %alias "IE_SET_UP_TERMINAL"
%externalbytespec Terminal Model %alias "IE_TT_MODEL"

%string(255)%fn translate command symbol(%string(255)s)
! Acquire the value of symbol S.  If not defined, return itself.
%integer t
  %result = "" %if s=""
  upper(s)
  t = refname(s,comdict); %result = s %if t=0
  t = integer(t); %result = s %if t=0
  transname(t,s)
  %result = s
%end
!

%recordformat addresseef(%record(addresseef)%name next,prev,
%record(personf) b,
%string(31) dear,
%string(80) name,
%string(31) yourrefce,
%string(31) yours)
%recordformat addresseelistf(%record(addresseef)%name head,tail)
%integer addresseeno
%record(addresseelistf) addressees
%constinteger addressflag=16_200            ;!  Flag for reedit.
%record(line80listf) bcc
%record(line80listf) cc
%constreal chperinch=12        ;!  Characters per inch for font Times10.
%routinespec collect recipients(%record(line80listf)%name u)
{!  If Vax.}
{%ownstring(63) command         ;!  Name of command file to be created.}
!
%integer create labels
%record(dataf)%array data(0:31)
{!  If Vax.}
{%recordformat df(%integer l, a)}
{%record(df) d}
{%conststring(3) defaultext="imp"}
{%ownstring(31) defaulthead="U0:[sm.head]department.lay"}
{%externalintegerfnspec do command %alias "LIB$DO_COMMAND"(%record(df)%name d)}
{%externalintegerfnspec spawn %alias "LIB$SPAWN"(%record(df)%name d)}
{%externalstring(255)%fnspec translate(%string(*)%name s)}
!
!  If APM.
%ownstring(31) defaulthead="office:department"
!
%constinteger dearflag=16_400   ;!  Flag for reedit.
%ownstring(31) defaultdear=""
{!  If Vax.}
{%ownstring(31) defaultdir="U0:[KBD]"}
!
!  If APM.
%ownstring(31) defaultdir="office:"
!
%ownstring(31) defaultyours=""
%externalroutinespec delete(%string(255) s)
%record(line80listf) editors
{!  If Vax.}
{%conststring(3) editext="lay"}
!
!  If APM.
%conststring(3) editext=""
!
%conststring(255) edmess= %c
"Only VECCE and IE are currently known to Letters.
Please assign one of these to LETTER_EDITOR in your login.com file."
%string(15) edt
%string(63) email
%string(255) enc
%string(255) ext
%ownstring(31) fax="031 667 7938"
%integer flag,flag7,flag15,flag16,flag17
%string(7) flcpy
%record(line80listf) heading
%owninteger horizlabels=2       ;!  Maximum number of labels across the page.
%integer i,j
%constreal indent=0.2           ;!  Left-hand margin on each label in inches.
%constreal labeldepth=1.575     ;!  Depth of a label in inches.
%recordformat labelf(%record(labelf)%name next,prev,%record(line80listf) b)
%recordformat labellistf(%record(labelf)%name head,tail)
%record(labellistf) label list
%string(31) labels
%integer labelstolaser
%constreal labelwidth=3.741     ;!  Width of a label in inches.
%constreal leftmargin=0.2       ;!  Margin at left of a label.
%string(31) letterhead
{!  If Vax.}
{%conststring(31) letterhelp="u0:[sm.office]letterhelp.imp"}
!
!  If APM.
%conststring(31) letterhelp="office:letterhelp"
!
%string(31) letters
%conststring(13) lett="letters_"
%ownreal linewidth=79
%constreal linesperinch=6       ;!  Lines per inch for Times10.
%constinteger menu1=16_83ffffff ;!  Menu for changes.
%string(31) myrefce
!  If APM.
%conststring(31) namelist="sm:persdata"
!
%constinteger nameflag=16_100   ;!  Flag for reedit.
{!  If Vax.}
{%conststring(31) namelist="u0:[sm.office]persdata.imp"}
!
%externalrecord(line80f)%mapspec newline80
%record(line80listf) nillist
%string(255) outname
%ownreal printdepth=0
%ownstring(15) printer="lp2"
%ownrecord(line80listf) printerlist
%ownstring(255) printmess= %c
"Newletts knows about  lp2 and lp3. Please assign one of these
to LETTERS_PRINTER."
%record(line80listf) star
%record(line80listf) sent by
%integer stage
%string(31) telephone number
%string(31) telex
%integer tolaser
%constreal top=0.342            ;!  Margin at top of page of labels.
%constreal topmargin=0.2        ;!  Margin at top of label.
%routinespec trace(%string(255) s)
{!  If Vax.}
{%constinteger tracechan=7}
!
!  If APM.
%constinteger tracechan=1
!
%string(31) u
%externalstring(12)%fnspec username
%ownstring(19)%array var(0:31)=
"Create output",        { 0}
"heading",              { 1}
"telex",                { 2}
"telephone_number",     { 3}
"extension",            { 4}
"email",                { 5}
"my_reference",         { 6}
"addressees",           { 7}
"name",                 { 8}
"address",              { 9}
"default dear",         {10}
"your_reference",       {11}
"editor",               {12}
"letter_file",          {13}
"default yours",        {14}
"sent_by",              {15}
"cc",                   {16}
"bcc",                  {17}
"enclosure",            {18}
"file_copy",            {19}
"print_letters",        {20}
"create_labels",        {21}
"print_labels",         {22}
"printer",              {23}
"directory",            {24}
"fax",                  {25}
"",                     {27}
"",                     {27}
"",                     {28}
"",                     {29}
"",                     {30}
"Abandon"               {31}
%owninteger vertlabels=7        ;!  Maximum number of labels down the page.
%externalroutinespec view(%string(255) file,topic)
%record(line80listf) yesnostar
%string(80) yesnomess= %c
"Only  y  and  n  and  *  and  .end  are legitimate responses."
%constinteger yoursflag=16_4000 ;!  Flag for reedit.


%record(labelf)%map newlabel
%record(labelf)%name p
%record(labelf) pattern
  p==new(pattern)
  p_next==nil; p_prev==nil
  p_b_head==nil; p_b_tail==nil
  %result==p
%end

%routine print line(%string (255) s)
  printstring(s); newline
%end

%routine done(%integer first)
%string(80) x
  %if first=yes %then x="inputting" %else x="changing"
  screen message("stopped while ".x." ".var(stage),"stop")
%end

%routine destroy(%string(255) s)
{!  If Vax.}
{%string(255) u,v}
!

  %on %event 1,2,3,4,5,6,7,8,9,10,11,12,13,14 %start
    trace("Event ".itod(event_event).",".itod(event_sub)."  ".Event_message)
    %return
  %finish

{!  If Vax.}
{  s=s.";" %unless s->u.(";").v}
!
  delete(s)
%end

%routine insert list before(%record(line80listf)%name u,%record(line80f)%name p,
%record(line80listf)%name v)
%record(line80f)%name q,r
  %return %if u==nil %or u_head==nil
  q==u_head
  %while q##nil %cycle
    r==newline80
    r_line=q_line
    %if p==nil %then append cell(r,v) %else insert cell before(r,p,v)
    q==q_next
  %repeat
%end

%routine h(%integer stage)
%string(255) topic,x,y
  %if 0<=stage<=31 %then topic=var(stage) %else topic=""
  topic=x." ".y %while topic->x.("_").y
  view(letterhelp,topic)
%end

%routine trace(%string(255) s)
%integer oldout
%owninteger first=yes
  %if first=yes %thenstart
    first=no
    open output(tracechan,"trace")
  %finish
  oldout=outstream
  select output(tracechan)
  write(instream,1); write(oldout, 3); print string(" ".s)
  newline
  select output(oldout)
%end


%routine remove(%record(*)%name p,l)
  excise cell(p,l)
  dispose(p)
%end

%routine copy lines(%record(line80listf)%name a,b)
%record(line80f)%name p,q
  b_head==nil; b_tail==nil
  p==a_head
  %while p##nil %cycle
    q==newline80
    q_line=p_line
    append cell(q,b)
    p==p_next
  %repeat
%end

%routine clear recipient(%record(addresseef)%name r)
  r_next==nil; r_prev==nil
  r_dear=""; r_name=""; r_yours=""; r_yourrefce=""
  clear person(r_b)
%end

%record(addresseef)%map newrecipient
%record(addresseef) recippattern
%record(addresseef)%name p
  p==new(recippattern)
  clear recipient(p)
  %result==p
%end

%string(255)%fn full name of(%record(personf)%name a)
%string(255) u,v
  %if a##nil %thenstart
    %if "*"#a_surname#"" %thenstart
      u=a_surname %unless a_surname->u.(",").v %and v=""
      %if "*"#a_style#"" %then v=a_style." " %else v=""
      v=v.a_initials %if "*"#a_initials#""
      u=v.u
    %finishelse u=""
    u=a_id %if u=""
  %finishelse u=""
  %result=u
%end

!  This discards leading blank lines and spaces.
!  It returns ".end" if '.end' or <EOF> is encountered.

%routine read word(%string(*)%name a)
%integer j
%string(255) x
  %on %event 9 %start
    a=end
    %return
  %finish
  skip symbol %while next symbol=sp %or next symbol=nl
  a=""
  read symbol(j) %and a=a.tostring(j) %while sp#next symbol#nl
  x=a
  lower(x)
  a=x %if x=end
%end

!  This uses input stream 3.

%routine append text(%string(255) s)
%integer i,oldin
  %on %event 9 %start
    close input %if instream#0
    select input(oldin)
    %return
  %finish
  oldin=instream
  open input(3,s)
  select input(3)
  %cycle
    read symbol(i)
    print symbol(i)
  %repeat
%end

%routine print recipient(%record(addresseef)%name r,%string(255) s)
  print line(snl.s) %unless s=""
  print line("Id=".r_b_id)
  %return %if r_b_id=end
  print line(r_name.",")
  print address(r_b_officeaddr,":tt")
  print line("Dear ".r_dear)
  print line("Yours ".r_yours)
%end

%routine print style
  print line("$D #='$K163'")
  print line("$D.var pageno,top")
  print line("$D.format pages")
  print line("=$Q(1-pageno)$O0.2"",Y,6.85"",H-Y-0.5""[]")
  print line("=$Q(pageno)$O0.2"",0.5"",6.85"",H-0.5""[]")
  print line("=$pageno=pageno+1")
  print line("=$Q(pageno-1)$B0.1""$Times12{$v(pageno)}$B^0")
  print line("=$C")
  print line("=$pages")
  print line("$Z.include office:crest")
  print line("$S*.letter")
%end

%routine print form(%record(line80f)%name bcc,%string(7) file)
%string(255) u
  print line("$M0.5"",0,7.2"",11""")
  print line("$X0$Y0")
  print line("$T=0.5"",1"",1.5"",2"",2.5"",". %c
  "3"",3.5"",4"",4.5"",5"",5.5"",6"",6.5"",7"",7.5"",8""")
  print line("$L=0.2""?$G=2$I=3$J0")
  print line("$pageno=0")
  %if file="file" %then u="FILE COPY" %else %c
  %if file="bcc" %then u="Copy for ".bcc_line %else u=""
  print line("$Times12")
  %if u="" %then print line("$B1") %else print line("$H{".u."}$B^0")
  print line("$top=Y")
  print address(heading,"")
  %if "*"#telephone number#"" %or "*"#telex#"" %or "*"#fax#"" %thenstart
    print string("$B0.05""")
    %if "*"#telephone number#"" %thenstart
      print string("$I{Telephone:} ".telephone number)
      print string(" $I{Ext: }".ext ) %if "*"#ext#""
    %finish
!  $T0 is to delimit the text to be right-justified.
    print string(snl."$T0$I{Telex: }".telex."$X>7""") %if "*"#telex#""
    print string(snl."$B0.05""$I{Email: }".email) %if "*"#email#""
!  $T0 is to delimit the text to be right justified.
    print string(snl."$T0$I{Fax: }".fax."$X>7""") %if "*"#fax#""
    print string("$B0")
    newline
  %finish
  print line("$Times12")
  print line("$pages")
%end

%routine print head(%record(addresseef)%name r,%record(line80f)%name bcc,
%string(7) file)
%string(255) u,v
  print form(bcc,file)
  %if r##nil %thenstart
    print string("$B0")
    print string("$I{My reference: }".myrefce) %if "*"#myrefce#""
    print string("$B0$I{Your reference: }".r_yourrefce) %c
    %if "*"#r_yourrefce#""
    newline %if "*"#myrefce#"" %or "*"#r_yourrefce#""
    print string("$B1 ".r_name.",$T0 ".ddate."$B>0".snl)
    print address(r_b_officeaddr,"layout")
    print string("$B0")
    r_dear=defaultdear %if r_dear=""
    %if "*"#r_dear#"" %thenstart
      print string("Dear ".r_dear)
      print string(",") %unless r_dear->u.(",").v %and v=""
      newline
      print string("$B0")
    %finish
  %finishelse print string("$B0.3""$T0 ".ddate."$X>7""".snl."$B0.25""".snl)
  print string("$L1$J1".snl)    ;!  Set line-filling ON and Justification ON.
%end

%routine print copy list(%record(line80listf)%name copy,%string(31) c,
%integer arrow)
%integer p
%string(80) u
%record(line80f)%name a
  %if copy##nil %and copy_head##nil %c
  %and copy_head_line#"*" %and copy_head_line#"" %thenstart
    print string("$B0".snl)
    print string("$B1".c) %if a##nil
    p=1
    a==copy_head
    %while a##nil %cycle
      u=a_line
      %if p=arrow %then u="$T0 ->$T>1 ".u %else u="$T1 ".u
      print string(u."$B0".snl)
      p=p+1
      a==a_next
    %repeat
  %finish
%end

%routine print names(%record(addresseelistf)%name a)
%record(addresseef)%name p
%string(80) u
  %return %if a==nil %or a_head==nil
  print string("$B1 Also sent to:- ")
  print string("$T*2")
  p==a_head
  %while p##nil %cycle
    u=full name of(p_b)
    print string(u)
    p==p_next
    print string(",") %unless p==nil
    newline
  %repeat
  newline
  print string("$B1$T*0".snl)
%end

%routine print tail(%record(addresseef)%name r,
%record(line80listf)%name copy,bcopy,%integer arrow,%string(7) file)
%integer lines
%real c
%string(255) u,v
%record(line80f)%name p
  print string("$Times12".snl)
  print string("$T*0".snl)
  lines=0
  p==sent by_head
  lines=lines+1 %and p==p_next %while p##nil
  r_yours=defaultyours %if r_yours=""
  %if r##nil %and "*"#r_yours#"" %thenstart
    c=1.2+lines/5
    print string("$B0.2"",".rtod(c,1,2)."""".snl)
    print string("Yours ".r_yours)
    print string(",") %unless r_yours->u.(",").v %and v=""
    print string("$B^0".snl)
  %finish
  %if sent by_head##nil %thenstart
    print string("$B0.75""")
    print address(sent by,"centre")
  %finish
  print string("$B1 Encl:- ".enc.snl) %if "*"#enc#""
  print copy list(copy,"cc:",arrow)
  %if file="file" %thenstart
    print copy list(bcopy,"bcc:",arrow)
    print names(addressees) %if addresseeno>1
  %finish
  print string("$E*".snl)
%end

%routine xedit(%string(*)%name a)
%string(63) u,w
!  If APM.
%integer start line,start position
!
{!  If Vax.}
{%record(df) d}
{%integer flag}
!
  a=u.w %while a->u.("_").w %or (edt="vecce" %and a->u.(" ").w)
  %if edt="vecce" %thenstart
    w="" %unless a->a.("/").w
    u="" %unless a->a.(",").u
    u=fix file(u,defaultdir,editext)
    a=fix file(a,defaultdir,editext)
    %if w="" %then w=a %else w=fix file(w,defaultdir,editext)
    a="No name given for document." %and %return %if w=""
    a=a.",".u %unless u=""
    a=a."/".w
    clear frame
    memed(a)
!  If APM.
    set video mode(screen mode+special pad)
!
    clear frame
  %finishelse %if edt="ie" %thenstart
    w="" %unless a->a.(" ").w %or a->a.("/").w
    a=fix file(a,defaultdir,editext)
    %if w="" %then w=a %else w=fix file(w,defaultdir,editext)
    a=a." ".w
{!  If Vax.}
{    u=edt." ".a}
{    d_a=addr(u)+1; d_l=length(u)}
{    flag=spawn(d)}
{    message("Flag from ".u."=".itoh(flag),"") %if flag&1=0}
{    start screen mode}
!
!  If APM.
    start line=1; start position=1
    terminal model=6
    set up terminal
    a=u.w %while a->u.(" ").w
    ie editor(a,a,0,20,start line,start position,
    Default  Profile,Default Keyboard,Confirm!Silent!Reset Heap)
    reset terminal
!
  %finishelse message("You are trying to use ".Edt.".".snl.edmess,"stop")
  a=w
  select input(0); select output(0)
  prompt("")
  set video mode(screenmode+special pad)
%end

%routine trim trailing commas and spaces(%string(*)%name a)
  length(a)=length(a)-1 %while length(a)>0 %c
  %and (charno(a,length(a))=',' %or charno(a,length(a))=sp)
%end

%routine trim address(%record(line80listf)%name address)
%record(line80f)%name p,q
  p==address_head
  %while p##nil %cycle
    trim trailing commas and spaces(p_line)
    q==p
    p==p_next
    excise cell(q,address) %and dispose(q) %if q_line=""
  %repeat
  %if address_tail##nil %thenstart
    p==address_tail
    length(p_line)=length(p_line)-1 %while length(p_line)>0 %c
    %and charno(p_line,length(p_line))='.'
  %finish
%end

%routine read line(%string(*)%name a)
%integer j
  a=""
  %while next symbol#nl %cycle
    read symbol(j)
    a=a.tostring(j)
  %repeat
  skip symbol    ;!  To get rid of nl.
%end

%routine read lines(%record(line80listf)%name a)
%record(line80f)%name p
%string(255) u,v
  a_head==nil; a_tail==nil
  %cycle
    skip symbol %while next symbol=sp
    read line(u)
    v=u; lower(v)
    screen message("Stopped while changing ".var(stage),"stop") %if v=end
    %exit %if v="*"
    p==newline80
    p_line=u
    append cell(p,a)
  %repeat
%end

%routine read screen lines(%record(line80listf)%name a)
%record(line80f)%name p
%string(255) u
  skip symbol %while next symbol=sp %or next symbol=rt
  %cycle
    read screen line(u)
    %exit %if u="*"
    p==newline80
    p_line=u
    append cell(p,a)
  %repeat
%end

%routine collect(%string(*)%name a)
%string(63) u
  read screen line(a)
  u=a; lower(u)
  screen message("Stopped while changing ".var(stage),"stop") %if u=end
%end

%routine collect lines(%record(line80listf)%name a)
%string(63) u,v,w
%record(line80f)%name p

  %on %event 9 %start
    message("Stopped while changing ".var(stage),"stop")
  %finish

  select input(0)
  v=var(stage).".imp"
  v=u.w %while v->u.("_").w %or v->u.(" ").w
  open output(3,v); select output(3)
  p==a_head
  %while p##nil %cycle
    print string(p_line.snl) %if p_line#"*"
    p==p_next
  %repeat
  print string("*".snl)
  close output
  select input(0); select output(0)
  delete list(a)
  xedit(v)
  open input(3,v); select input(3)
  read lines(a)
  close input %if instream#0
  select input(0)
  destroy(v)
%end

!  This requires Name, Address, Dear and Yours.
!  It fills in the Default values for Dear and Yours if * is read.
!  The Default values may be null.

%routine get addressee(%record(addresseef)%name r)
%integer oldstage
%string(63) u

  %on %event 9,15 %start
    message("stopped while changing ".var(stage),"stop") %c
    %if event_event=15 %and event_sub=1
    close input %and select input(0) %if event_event=9 %and instream#0
    clear recipient(r)
    stage=oldstage
    %return
  %finish

  r_b_id=""    ;!  Clear recipient sets r_b_id to end.
  oldstage=stage
!  Input name of addressee
  stage=8
  skip symbol %while next symbol=sp %or next symbol=nl
  read line(u)
  prune(u)
  r_b_id=u; r_name=u
  %signal %event 15,2 %if u="*"  ;!  No more addressees.
  stage=oldstage %c
  %and %return %if length(u)>0 %and charno(u,1)='@'    ;!  File name.
!  Get address of addressee.
  stage=9
  read lines(r_b_officeaddr)
  trim address(r_b_officeaddr)
!  Dear.
  stage=10
  read line(r_dear)
  r_dear=defaultdear %if r_dear=""
!  Yours.
  stage=14
  read line(r_yours)
  r_yours=defaultyours %if r_yours=""
  stage=oldstage
%end

%routine get more addressees
%record(addresseef)%name r
  %cycle
    r==newrecipient
    get addressee(r)
    %exit %if r_b_id=end
    append cell(r,addressees)
    addresseeno=addresseeno+1
  %repeat
  dispose(r)
%end

%routine expand address files
%record(addresseef)%name p,q,r
%string(255) u
  select input(0)
!  Expand any filenames into addressees.
  p==addressees_head
  %while p##nil %cycle
    %if p_name->("@").u %thenstart
!  Report if file does not exist.
      %if %not exists(u) %then p_name=u." does not exist." %else %c
      open input(3,u)
      select input(3)
!  This inserts the new addressees after p in the list of addressees
      %cycle
        r==newrecipient
        get addressee(r)
        %exit %if r_b_id=end
        insert cell after(r,p,addressees)
        addresseeno=addresseeno+1
      %repeat
      dispose(r)    ;!  Because r_b_id=end.
      close input %if instream#0
      select input(0)
      q==p; p==p_next
      excise cell(q,addressees)
      dispose(q)
      addresseeno=addresseeno-1
    %finishelse p==p_next
  %repeat
%end

%routine get addressees
  addresseeno=0
  addressees_head==nil; addressees_tail==nil
  get more addressees
  expand address files
  stage=7
%end

%routine  print letter(%record(addresseef)%name r,%record(line80f)%name bcc,
%record(line80listf)%name copy,bcopy,%integer arrow,%string(31) outname,
%string(7) file)
  select output(2)
  print head(r,bcc,file)
  append text(outname)
  print tail(r,copy,bcopy,arrow,file)
  select input(0)
  select output(2)
%end

%routine list label(%record(line80listf)%name b)
%record(labelf)%name lbl
  %return %if b==nil
  lbl==new label
  copy lines(b,lbl_b)
  append cell(lbl,label list)
%end

%routine p label(%record(personf)%name a)
%record(line80f)%name p
%record(line80listf) b
%string(255) u
  select output(3)
  b_head==nil; b_tail==nil
  %if "*"#a_surname#"" %thenstart
    copy lines(a_officeaddr,b)
    %if "*"#a_department_line#"" %thenstart
      p==newline80
      p_line=a_department_line
      prefix cell(p,b)
    %finish
    %if a_style="" %or a_style="*" %then u="" %else u=a_style." "
    u=u.a_initials.a_surname
    u=u." ".a_degrees %if "*"#a_degrees#""
    prune(u)
    p==newline80
    p_line=u
    prefix cell(p,b)
  %finishelsestart
    %if "*"#a_id#"" %then u=a_id %else u=""
    u=u.", Room".a_room %if ""#a_room#"*"
    %if u#"" %thenstart
      p==newline80
      p_line=u
      append cell(p,b)
    %finish
  %finish
  list label(b)
  delete list(b)
%end

%routine print letters(%record(addresseelistf)%name recips,
%record(line80listf)%name copy,bcopy)
%integer i
%record(line80listf) b
%record(labelf)%name lbl
%record(line80f)%name a,p
%record(addresseef)%name r
%record(personf)%name c
%record(personlistf) d
  select output(0)
  print line("LETTERS WILL BE CREATED IN ".letters)
  open output(2,letters)
  select output(2)
  print style
  %if create labels=yes %thenstart
    select output(0)
    print line("LABELS WILL BE CREATED IN ".LABELS)
    d_head==nil; d_tail==nil
  %finish
  select output(2)
  r==recips_head
  %while r##nil %cycle
    print letter(r,nil,copy,bcopy,0,outname,"")
    select output(0)
    print line("Letter created for ".r_name)
    select output(2)
!  Create label.
    %if create labels=yes %thenstart
      copy lines(r_b_officeaddr,b)
      p==newline80
      p_line=r_name
      prefix cell(p,b)
      list label(b)
      delete list(b)
    %finish
    r==r_next
  %repeat
  select output(2)
  r==recips_head
  print letter(r,nil,copy,bcopy,-1,outname,"file") %and %c
  select output(0) %and %c
  print line("Copy created for FILE") %if flcpy="yes"
  i=1
  %unless copy==nil %or copy_head==nil %c
  %or copy_head_line="*" %or copy_head_line="" %thenstart
!  There is a list for cc:.
    r==recips_head
    a==copy_head
    %while a##nil %cycle
      select output(2)
      print letter(r,nil,copy,bcopy,i,outname,"copy")
      select output(0)
      print line("Copy created for ".a_line)
      i=i+1
      a==a_next
    %repeat
  %finish
  %unless bcopy==nil %or bcopy_head==nil %c
  %or bcopy_head_line="*" %or bcopy_head_line=""  %thenstart
!  There is a list for bcc:.
    r==recips_head
    a==bcopy_head
    %while a##nil %cycle
      select output(2)
      print letter(r,a,copy,bcopy,0,outname,"bcc")
      select output(0)
      print line("Copy created for ".a_line)
      a==a_next
    %repeat
  %finish
  select output(2)
  print line("$E*.letter".snl."$E*")
  close output
  %if create labels=yes %thenstart
    concat lists(copy,bcopy)
    a==copy_head
    %while a##nil %cycle
      c==newperson
      c_id=a_line
      append cell(c,d)
      a==a_next
    %repeat
    identify(d,namelist,0)
    c==d_head
    %while c##nil %cycle
       p label(c)
       c==c_next
    %repeat
    select output(3)
    i=0; lbl==label list_head
    %while lbl##nil %cycle
      i=i+1
      lbl==lbl_next
    %repeat
    %if i>0 %thenstart
      i=i//(horizlabels*vertlabels); i=1 %if i=0
      open output(3,labels); select output(3)
      print string("$Z.pause Insert ".itod(i)." sheets of labels.".snl)
      print label style
      lbl==label list_head
      %while lbl##nil %cycle
        print label(lbl_b)
        lbl==lbl_next
      %repeat
      print string(snl."$E*".snl)
      close output
      select output(0)
      print string("NAMES AND ADDRESSES FOR LABELS ARE IN ".labels)
      newline
      delete list(label list)
    %finish
  %finish
  select output(0)
%end

%routine separate ids(%record(line80listf)%name l)
%record(line80f)%name p,q
%string(63) u,w
  p==l_head
  %while p##nil %cycle
    w=p_line
    %while w#"" %cycle
      u=w %and w="" %unless w->u.(";").w
      q==newline80
      q_line=u
      insert cell before(q,p,l)
    %repeat
    q==p
    p==p_next
    excise cell(q,l)
    dispose(q)
  %repeat
%end

%routine expand id files(%record(line80listf)%name l)
%record(line80f)%name p,q
%record(line80listf) u
%string(31) f
  p==l_head
  %while p##nil %cycle
    %if p_line->("@").f %thenstart
      open input(3,f); select input(3)
      collect recipients(u)
      close input; select output(0)
      insert list before(u,p,l)
      q==p
      p==p_next
      excise cell(q,l)
      dispose(q)
    %finishelse p==p_next
  %repeat
%end

%routine collect recipients(%record(line80listf)%name u)
%integer flag,source
%string(63) v
%record(line80f)%name p

  %on %event 9 %start
    p_next==nil; p_prev==nil
    p_line=""
    append cell(p,u)
    -> continue
  %finish

  source=0
  v=var(stage).".imp"
  open output(3,v)
  select output(3)
  p==u_head
  %while p##nil %cycle
    print string(p_line) %and newline %if "*"#p_line#""
    p==p_next
  %repeat
  print string(snl."*".snl)
  close output
  select input(0); select output(0)
  delete list(u)
  xedit(v)
  open input(3,v); select input(3)
  flag=yes
  source=3
  read lines(u)
!  The program is stopped if .end is read.
continue:
  close input %and destroy(v) %if instream#0
  select input(0); select output(0)
  prompt("")
  separate ids(u)
  expand id files(u)
%end

%routine set value(%integer item,%string(63) val)
%record(line80f)%name p
  delete list(data(item)_val)
  p==newline80
  p_line=val
  append cell(p,data(item)_val)
%end

%routine set values(%integer item,%record(line80listf)%name vals)
  delete list(data(item)_val)
  copy lines(vals,data(item)_val)
%end

%routine pack values(%record(line80listf)%name l)
%string(63) s,t,u
%record(line80f)%name p,q
%record(line80listf) m
  %return %if l==nil %or l_head==nil
  m_head==nil; m_tail=nil
  p==l_head
  s=""
  %while p##nil %cycle
    u=p_line
    %while u#"" %cycle
      t=u %and u="" %unless u->t.(";").u
      %if length(t)+length(s)+3>60 %thenstart
        q==newline80
        q_line=s
        append cell(q,m)
        s=""
      %finish
      %if s="" %then s=t %else s=s."; ".t
    %repeat
    p==p_next
  %repeat
  %if s#"" %thenstart
    q==newline80
    q_line=s
    append cell(q,m)
  %finish
  set values(stage,m)
%end

%routine set vals(%integer flags)
%record(addresseef)%name q
  %if addresseeno=0 %thenstart
    set value(7,"No addressees")
    set value(8,"")
    set value(9,"")
    set value(10,"")
    set value(14,defaultyours)
  %finishelsestart
    %if addresseeno=1 %then set value(7,"One addressee") %c
    %else set value(7,itod(addresseeno)." addressees")
    q==addressees_head
    set value(8,q_name) %if flags&nameflag#0 %and q##nil
    %if flags&addressflag#0 %thenstart
      %if q##nil %and q_b_officeaddr_head##nil %c
      %then set value(9,q_b_officeaddr_head_line) %else set value(9,"")
    %finish
    set value(10,addressees_head_dear) %if flags&dearflag#0 %and q##nil
    set value(14,addressees_head_yours) %if flags&yoursflag#0 %and q##nil
  %finish
%end

%routine reedit
%integer n
%record(addresseef)%name q
%string(255) u,v,w
%switch case(0:31)

  %on %event 3,9,15 %start
    trace("In Reedit:  Event ".itod(event_event).",".itod(event_sub). %c
    "  ".Event_message)
    message("Stopped while changing ".var(stage),"stop")
  %finish

  stage=0
  set mode(underline)
  %cycle
    set up menu(data,menu1)
    select input(0); select output(0)
    write menu
    stage=cursor depth
    ->case(stage)

case(1):
!  Read name of file containing heading.
    write instruction( %c
    "Type the name of a file containing the heading of the letters.")
    collect(letterhead)
    letterhead=fix file(letterhead,defaultdir,defaultext)
    %if letterhead#"" %and %not exists(letterhead) %thenstart
      set value(stage,letterhead." does not exist or no access.")
      %continue
    %finishelse set value(stage,letterhead)
    %continue %if letterhead=""
!  Read heading.
    open input(3,letterhead)
    select input(3)
    input lines(heading,n)
    close input %if instream#0
    select input(0)
    select output(0)
    %continue
case(2):
!  Telex.
    collect(telex)
    set value(stage,telex)
    %continue
case(3):
!  Telephone number.
    collect(telephonenumber)
    set value(stage,telephone number)
    %continue
case(4):
!  Extension.
    collect(ext) %unless telephone number=""
    set value(stage,ext)
    %continue
case(5):
!  Email address.
    collect(email)
    set value(stage,email)
    %continue
case(6):
! My reference.
    collect(myrefce)
    set value(stage,myrefce)
    %continue
case(7):
!  Addressees.
    stage=7
    write instruction( %c
    "Please edit the details of addressees into the file provided.")
!  Create file of addressees for editing.
    u=var(stage)
    u=v.w %while u->v.("_").w %or u->v.(" ").w
{!  If Vax.}
{    u=u.".imp"}
!
    open output(3,u); select output(3)
    q==addressees_head
    %while q##nil %cycle
      print string(snl.q_name.snl)
      print lines(q_b_officeaddr)
      print string("*".snl)
      %if q_dear#"" %then print string(q_dear.snl) %else print string("*".snl)
      %if q_yours#"" %then print string(q_yours.snl) %c
      %else print string("*".snl)
      q==q_next
    %repeat
    print string(snl."*".snl)
    close output
    delete list(addressees)
    select input(0); select output(0)
!  Edit the file of addressees.
    xedit(u)
!  Read addressees from edited file.
    open input(3,u); select input(3)
    get addressees
    close input %if instream#0
    select input(0)
    flag7=yes
    set vals(addressflag!dearflag!nameflag!yoursflag)
    stage=7
    destroy(u)
    %continue
case(8):
!  Name.
    %if addresseeno=0 %then q==newrecipient %else %c
    %if addresseeno=1 %then q==addressees_head %and excise cell(q,addressees) %c
    %else screen message("Edit the file of addressees.","") %and ->case(7)
    collect(q_name)
    append cell(q,addressees)
    addresseeno=1
    set vals(nameflag)
    %continue
case(9):
!  Address.
    %if addresseeno=0 %then q==newrecipient %else %c
    %if addresseeno=1 %then q==addressees_head %and excise cell(q,addressees) %c
    %else screen message("Edit the file of addressees.","") %and ->case(7)
    read screen lines(q_b_officeaddr)
    trim address(q_b_officeaddr)
    append cell(q,addressees)
    addresseeno=1
    set vals(addressflag)
    %continue
case(10):
!  Dear.
    %if addresseeno=0 %then q==newrecipient %and addresseeno=1 %else %c
    %if addresseeno=1 %then q==addressees_head %and excise cell(q,addressees) %c
    %else screen message("Edit the file of addressees.","") %and ->case(7)
    collect(q_dear)
    append cell(q,addressees)
    addresseeno=1
    set vals(dearflag)
    %continue
case(11):
!  Your reference.
    %if addresseeno#1 %thenstart
      set value(stage,"Not unless exactly one adddressee has been defined.")
      %continue
    %finish
    q==addressees_head
    collect(q_yourrefce)
    set value(stage,q_yourrefce)
    %continue
case(12):
!  Editor.
    collect(edt)
    lower(edt)
    edt="ie" %if edt=""
    set value(stage,edt)
    %continue
case(13):
!  Outname.
    write instruction( %c
    "Give the name of a file to contain the body of the letter.")
    collect(outname)
    set value(stage,outname)
    xedit(outname)
    %continue
case(14):
!  Yours.
    %if addresseeno=0 %then q==newrecipient %and addresseeno=1 %else %c
    %if addresseeno=1 %then q==addressees_head %and excise cell(q,addressees) %c
    %else screen message("edit the file of addressees.","") %and ->case(7)
    collect(q_yours)
    append cell(q,addressees)
    addresseeno=1
    set vals(yoursflag)
    %continue
case(15):
!  Sent by.
    write instruction( %c
    "Edit the file that will contain the current information about the sender.")
    clear frame
    collect lines(sentby)
    set values(stage,sentby)
    flag15=yes
    %continue
case(16):
!  Cc:.
    write instruction( %c
    "Edit the file containing the current Cc: list.")
    clear frame
    collect recipients(cc)
    pack values(cc)
    flag16=yes
    %continue
case(17):
!  Bcc:.
    write instruction( %c
    "Edit the file containing the current Bcc: list.")
    clear frame
    collect recipients(bcc)
    pack values(bcc)
    flag17=yes
    %continue
case(18):
!  Enclosures.
    collect(enc)
    set value(stage,enc)
    %continue
case(19):
!  File copy.
    collect(flcpy)
    lower(flcpy)
    set value(stage,flcpy)
    %continue
case(20):
!  Tolaser.
    u=tostring(tolaser)
    collect(u)
    lower(u)
    %if u="" %then tolaser=0 %else tolaser=charno(u,1)
    set value(stage,tostring(tolaser))
    %continue
case(21):
!  Createlabels.
    collect(u)
    lower(u)
    %if u="" %then create labels=0 %else create labels=charno(u,1)
    set value(stage,tostring(create labels))
    %if create labels=no#labels to laser %thenstart
      stage=22
      labels to laser=no
      set value(stage,to string(labels to laser))
    %finish
    %continue
case(22):
!  Labelstolaser.
    collect(u)
    lower(u)
    %if u="" %then labels to laser=0 %else labels to laser=charno(u,1)
    set value(stage,tostring(labels to laser))
    %if labels to laser=yes#create labels %thenstart
      stage=21
      create labels=yes
      set value(stage,tostring(create labels))
    %finish
    %continue
case(23):
!  Printer.
    collect(printer)
    set value(stage,printer)
    %continue
case(24):
!  Directory.
    collect(defaultdir)
    set value(stage,defaultdir)
    %continue
case(25):
! Fax.
    collect(fax)
    set value(stage,fax)
    %continue
case(26):
case(27):
case(28):
case(29):
case(30):
    message("Stage has been set to the illegitimate value ".itod(stage),"mon")
case(0):
    %if letterhead="" %then set value(0,"Set letterhead.") %else %c
    %if addressees_head==nil %then set value(0,"Provide addessees.") %else %c
    %if outname="" %then set value(0,"Provide file for letter.") %c
    %elsestart
!  If APM.
      lolight(1)
!
      %exit
    %finish
    %continue
case(31):
!  Abandon.
    select input(0); select output(0)
!  If APM.
    lolight(1)
!
    message("Letters abandoned.","stop")
  %repeat
%end

%routine initial settings
%integer i,n
%string(255) u
%record(line80f)%name p,q
!  Addresseeno, addressees, nilllist, val, yesnostart.
  addresseeno=0; addressees_head==nil; addressees_tail==nil
  nillist_head==nil; nillist_tail==nil
  %for i=0,1,31 %cycle
    data(i)_name=var(i)
    data(i)_val_head==nil
    data(i)_val_tail==nil
  %repeat
  yesnostar_head==nil; yesnostar_tail==nil
  p==newline80; p_line="yes"; append cell(p,yesnostar)
  p==newline80; p_line="no"; append cell(p,yesnostar)
  p==newline80; p_line="*"; append cell(p,yesnostar)
  p==newline80; p_line=end; append cell(p,yesnostar)
!  Bcc:.
  stage=17
  bcc_head==nil; bcc_tail==nil
  q==newline80; q_line="*"
  set up(q_line,lett.var(stage), var(stage),"",nillist)
  set value(stage,q_line)
  append cell(q,bcc)
!  Cc:.
  stage=16
  cc_head==nil; cc_tail==nil
  q==newline80; q_line="*"
  set up(q_line,lett.var(stage),var(stage),"",nillist)
  set value(stage,q_line)
  append cell(q,cc)
!  Createlabels.
  stage=21
  set up(u,lett.var(stage),var(stage),yesnomess,yesnostar)
  lower(u)
  %if u="" %then create labels=0 %else create labels=charno(u,1)
  set value(stage,tostring(create labels))
  %if create labels=no %thenstart
    labels to laser=no
    stage=22
    set value(stage,"no")
  %finish
!  Dear.
  stage=10
  set up(defaultdear,lett.var(stage),var(stage),"",nillist)
  defaultdear="*" %if defaultdear=""
  set value(stage,defaultdear)
!  Directory.
  stage=24
  set up(defaultdir,lett.var(stage),var(stage),"",nillist)
  set value(stage,defaultdir)
!  Editor.
  editors_head==nil; editors_tail==nil
  p==newline80; p_line="vecce"; append cell(p,editors)
  p==newline80; p_line="ie"; append cell(p,editors)
  stage=12
  set up(edt,lett.var(stage),var(stage),edmess,editors)
  edt="ie" %if edt=""
  set value(stage,edt)
!  Email address.
  stage=5
  set up(email,lett.var(stage),var(stage),"",nillist)
  set value(stage,email)
!  Enclosures.
  stage=18
  set up(enc,lett.var(stage),var(stage),"",nillist)
  set value(stage,enc)
!  Extension.
  stage=4
  set up(ext,lett.var(stage),var(stage),"",nillist) %unless telephonenumber=""
  set value(stage,ext)
  flag7=no; flag15=no; flag16=no; flag17=no
  stage=19
!  Fax. Facsimile.
  stage=25
  set up(fax,lett.var(stage),var(stage),"",nillist)
  set value(stage,fax)
!  File copy.
  set up(flcpy,lett.var(stage),var(stage),"",nillist)
  set value(stage,flcpy)
!  Read name of file containing heading.
  heading_head==nil; heading_tail==nil
  stage=1
  set up(letterhead,lett.var(stage),var(stage),"",nillist)
  letterhead=fix file(letterhead,defaultdir,defaultext)
  %if exists(letterhead) %then set value(stage,letterhead) %c
  %else set value(stage,letterhead."  does not exist")
!  Read heading.
  n=40
  open input(3,letterhead)
  select input(3)
  input lines(heading,n)
  close input %if instream#0
  select input(0)
  select output(0)
  %if heading_head##nil %thenstart
    u=heading_head_line; lower(u); done(no) %if u=end
    u=heading_tail_line; lower(u); done(no) %if u=end
  %finish
!  Labellist.
  labellist_head==nil; labellist_tail==nil
!  Labelstolaser.
  stage=22
  set up(u,lett.var(stage),var(stage),yesnomess,yesnostar)
  lower(u)
  labels to laser=charno(u,1) %if length(u)>0
  set value(stage,tostring(labels to laser))
  %if labels to laser=yes %thenstart
    stage=21
    create labels=yes
    set value(stage,tostring(create labels))
  %finish
  linewidth=labelwidth-2*leftmargin
!  My reference.
  stage=6
  set up(myrefce,lett.var(stage),var(stage),"",nillist)
  set value(stage,myrefce)
!  Outname.
  stage=13
  outname=""
  set value(stage,outname)
  printdepth=labeldepth-2*topmargin
!  Printer.
  printerlist_head==nil; printerlist_tail==nil
  p==newline80; p_line="lp2"; append cell(p,printerlist)
  p==newline80; p_line="lp3"; append cell(p,printerlist)
  p==newline80; p_line=end; append cell(p,printerlist)
  stage=23
  set up(printer,lett.var(stage),var(stage),printmess,printerlist)
  printer="lp2" %if printer=""
  set value(stage,printer)
!  Sent by.
  sent by_head==nil; sent by_tail==nil
  stage=15
  i=1
  %cycle
    p==newline80
    set up(p_line,"letters_sent_by".itod(i),var(stage),"",nillist)
    u=p_line; lower(u); done(no) %if u=end
    %exit %if u="*" %or u=""
    append cell(p,sent by)
    i=i+1
  %repeat
  set values(stage,sent by)
  stage=0
  star_head==nil; star_tail==nil
  p==newline80; p_line="*"; append cell (p,star)
!  Start video.
  select input(0); select output(0)
  start screen mode
!  Telex
  stage=2
  set up(telex,lett.var(stage),var(stage),"",nillist)
  set value(stage,telex)
!  Telephone number.
  stage=3
  set up(telephonenumber,lett.var(stage),var(stage),"",nillist)
  set value(stage,telephone number)
!  Tolaser.
  stage=20
  set up(u,lett.var(stage),var(stage),yesnomess,yesnostar)
  lower(u)
  to laser=charno(u,1)
  set value(stage,tostring(to laser))
!  Yours.
  stage=14
  set up(defaultyours,lett.var(stage),var(stage),"",nillist)
  set value(stage,defaultyours)
%end

{ Main Program}

!  Seqno uses input and output streams 1.

  %on %event 15 %start
    message(""".end"" or ""@"" read.","stop")
  %finish

  select input(0); select output(0)
  initial settings
  reedit
  labels=""; letters=""
!  If APM.
  labels=printer.":"  %if labelstolaser=yes
  letters=printer.":" %if tolaser=yes
!
  letters=letters."x".seqno.".lay"
  labels=labels."x".seqno.".lay" 
  message("No addressees.","stop") %if addressees_head==nil
  stop screen mode
  print letters(addressees,cc,bcc)
!  Delay for output to appear on the screen.
  j=0
  %for i=0,1,100000 %cycle
    j=j+1
  %repeat
{!  If Vax.}
{  command="comm".seqno.".com"}
{  open output(3,command)}
{  select output(3)}
{  %if tolaser=yes %thenstart}
{  !  The extra snl gives a blank password.}
{    print line("$tofs/user=".printer.ssp.letters.snl)}
{    print line("$if $status.eq.1 then delete ".letters.";*")}
{  %finish}
{  %if labelstolaser=yes %thenstart}
{  !  The extra snl gives a blank password.}
{    print line("$tofs/user=".printer.ssp.labels.snl)}
{    print line("$if $status.eq.1 then delete ".labels.";*")}
{  %finish}
{  print line("$delete sentby.*;*") %if flag15=yes}
{  print line("$delete addressees.imp;*") %if flag7=yes}
{  print line("$delete cc.imp;*") %if flag16=yes}
{  print line("$delete bcc.imp;*") %if flag17=yes}
{  print line("$delete ".command.";*")}
{  close output}
{  select output(0)}
{  u="@".command}
{  d_a=addr(u)+1; d_l=length(u)}
{  flag=0}
{  flag=spawn(d)}
{  message("Flag from ".u."=".itoh(flag),"") %if flag&1=0}
!
!  If APM.
  message("Letters sent to laser printer.","") %if tolaser=yes
  message("Labels sent to laser printer.","") %if labelstolaser=yes
!


%endofprogram