

{  28/7/86  17:22   letters}

%begin

%include "sm:consts.inc"
%include "sm:persons.inc"
%include "sm:utils.inc"
!  If APM.
%include "inc:fs.imp"
%include "inc:fsutil.imp"
%include "inc:util.imp"
%include "inc:dict.imp"
%include "ie:ie.inc"
%externalroutinespec reset terminal %alias "IE_RESET_TERMINAL"
%externalroutinespec run program(%string(255) file)
%include "inc:run.imp"
%externalroutinespec set up terminal %alias "IE_SET_UP_TERMINAL"
%integer start line,start position
%externalbytespec Terminal Model %alias "IE_TT_MODEL"
%constinteger WY 75=6
!

%recordformat addresseef(%record(addresseef)%name next,prev,
%record(personf) b,
%string(31) dear,
%string(80) name,
%string(31) truly,yourrefce)
%recordformat addresseelistf(%record(addresseef)%name head,tail)
%integer addresseeno
%record(addresseelistf) addressees
%integer ae,at
%record(personlistf) bcc
%constreal chperinch=12     ;!  Characters per inch for font Times10.
{!  If Vax.}
{%ownstring(63) command      ;!  Name of command file to be created.}
!
%integer control
%integer controlp           ;!  Stream bearing heading and details of sender.
%conststring(255) copymess= %c
"Only 'yes' and 'no' are legitimate values for LETTERS_FILE_COPY.
Please assign one of them in your login.com file."
{!  If Vax.}
{%conststring(31) defaulthead="U0:[sm.head]department.lay"}
{%recordformat df(%integer l, a)}
{%record(df) d}
{%externalroutinespec spawn %alias "LIB$SPAWN"(%record(df)%name d)}
{%externalstring(255)%fnspec translate(%string(*)%name s)}
!
%string(15) edt
!  If APM.
%conststring(31) defaulthead="office:department"
!
%conststring(15) editor="letters_editor"
%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(63) email
%string(255) enc
!  If APM.
%externalpredicatespec exists(%string(255) s)
!
%string(255) ext
%conststring(19) file copy="letters_file_copy"
%string(19) flcpy
%integer first time=yes
%record(line80listf) heading
%owninteger horizlabels=2    ;!  Maximum number of labels across the page.
%constreal indent=0.2        ;!  Left-hand margin on each label in inches.
%constreal labeldepth=1.575  ;!  Depth of a label in inches.
%string(31) labels
%constreal labelwidth=3.741  ;!  Width of a label in inches.
%constreal left=0.342        ;!  Margin at left of page of labels.
%constreal leftmargin=0.2    ;!  Margin at left of a label.
%string(31) letterhead
%string(31) letters
%ownreal linewidth
%constreal linesperinch=6    ;!  Lines per inch for Times10.
%string(31) myrefce
!  If APM.
%conststring(15) namelist="sm:persdata"
!
{!  If Vax.}
{%conststring(31) namelist="u0:[sm.office]persdata.imp"}
!
%record(personlistf) noname
%string(255) outname
%record(line80f)%name p
%ownreal printdepth
%record(line80f)%name s
%record(line80listf) sent by
%string(31) stage
%record(line80f)%name telephone
%integer tolaser,labelstolaser
%constreal top=0.342         ;!  Margin at top of page of labels.
%constreal topmargin=0.2     ;!  Margin at top of label.
{!  If Vax.}
{%externalstring(12)%fnspec username}
!
%record(line80listf) editors,copyvalues
%owninteger vertlabels=7     ;!  Maximum number of labels down the page.
%string(255) x,y,z

%routine set up(%string(*)%name a,%string(63) var,default,%string(255) errmess,
%record(line80listf)%name values)
  upper(var)
  a=var
{!  If Vax.}
{  a=translate(a)}
!
!  If APM.
  a=translate command symbol(a)
!
  lower(a); lower(var)
  a=default %and %return %if a=var
  message(Errmess,"stop") %if %not belongs(a,values)
%end

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

%routine copy address(%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_truly=""; 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) x,y
  %if a##nil %thenstart
    %if "*"#a_surname#"" %thenstart
      x=a_surname %unless a_surname->x.(",").y %and y=""
      %if "*"#a_style#"" %then y=a_style." " %else y=""
      y=y.a_initials %if "*"#a_initials#""
      x=y.x
    %finishelse x=""
    x=a_id %if x=""
  %finishelse x=""
  %result=x
%end

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

%routine read line(%string(*)%name a)
%integer j
  skip symbol %while next symbol=sp
  a=""
  %while next symbol#nl %cycle
    read symbol(j)
    a=a.tostring(j)
  %repeat
%end

%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
    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 string(snl.s.snl) %unless s=""
  print string("Id=".r_b_id.snl)
  %return %if r_b_id=end
  print string(r_name.",".snl)
  print address(r_b_officeaddr,":tt")
  print string("Dear ".r_dear.snl)
  print string("Yours ".r_truly.snl)
%end

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

%routine print form(%record(personf)%name bcc,%string(7) file)
%string(255) x
  print string("$M0.5"",0,7.2"",10.5""".snl)
  print string("$X0$Y0".snl)
  print string("$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""".snl)
  print string("$L=0.2""?$G=2$I=3$J0".snl)
  print string("$pageno=0".snl)
  %if file="file" %then x="FILE COPY" %else %c
  %if file="bcc" %then x="Copy for ".full name of(bcc) %else x="$B(A+B)"
  print string("$B0$Times12$H{".x."}$B^0".snl)
  print string("$top=Y".snl)
  print address(heading,"")
  print string("$Times12".snl)
  print string("$pages".snl)
%end

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

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

%routine print tail(%record(addresseef)%name r,
%record(personlistf)%name copy,bcopy,%integer arrow,%string(7) file)
  print string("$Times12".snl)
  print string("$T*0".snl)
  %if r##nil %and "*"#r_truly#"" %thenstart
    print string("$B0.2""".snl)
    print string("Yours ".r_truly)
    print string(",") %unless r_truly->x.(",").y %and y=""
    print string("$B^0".snl)
  %finish
  %if sent by_head##nil %thenstart
    print string("$B0.75""")
    print address(sent by,"centre")
  %finish
  %if addresseeno=1 %thenstart
    print copy list(copy,"cc:",arrow)
    print copy list(bcopy,"bcc:",arrow) %if file="file"
  %finishelse %c
  %if file="file" %then print copy list(copy,"Also sent to:-$B0",0)
  print string("$B1 Encl:- ".enc.snl) %if "*"#enc#""
  print string("$E*".snl)
%end

%routine get addressee(%record(addresseef)%name r)
  %on %event 9,15 %start
    clear recipient(r)
    %return
  %finish
  r_b_id=""    ;!  Clear recipient sets r_b_id to end.
!  Input name of addressee
  input(x,1)
  prune(x)
  r_b_id=x; r_name=x
  %signal %event 15,1 %if x="*"
  %return %if charno(x,1)='@'
!  Get address of addressee.
  get address(r_b_officeaddr,0)
  get(r_dear,4)
  prune(r_dear)
  r_dear="*" %if r_dear=""
  get(r_truly,26)
  prune(r_truly)
  r_truly="*" %if r_truly=""
%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) x
!  Expand any filenames into addressees.
  p==addressees_head
  %while p##nil %cycle
    %if p_name->("@").x %thenstart
!  Read file-name until it ="" or exists.
      %while x#"" %and %not exists(x) %cycle
        message(x." does not exist.","")
        get(x,17)
        p_name="@".x
      %repeat
      %if exists(x) %thenstart
        open input(3,x)
        select input(3)
!  Note the end of the insertion.
        q==p_next
!  This inserts the new addressees after p in adressees-list.
        %cycle
          r==newrecipient
          get addressee(r)
          %exit %if r_b_id=end
          insert cell before(r,q,addressees)
          addresseeno=addresseeno+1
        %repeat
        dispose(r)
        close input
        select input(control)
        q==p; p==p_next
        excise cell(q,addressees)
        addresseeno=addresseeno-1
      %finishelsestart
        message(x." does not exist","")
        q==p; p==p_next
        excise cell(q,addressees)
        addresseeno=addresseeno-1
      %finish
    %finishelse p==p_next
  %repeat
%end

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

%routine get body of letter(%string(*)%name outname)
%integer oldin
%string(255) x,y,z
  %on %event 15 %start
    message("Stopped from input in 'Get body of letter'","stop")
  %finish
  outname=""; x=""; y=""; z=""
  oldin=instream
  select input(control)
  %cycle
    input(outname,15)
    lower(outname)
!  Resolve outname.
    y="" %unless (edt="vecce" %and outname->y.("/").outname) %c
    %or (edt="ie" %and outname->y.(" ").outname)
    outname->(" ").outname %while charno(outname,1)=' '
    %signal %event 15 %if outname=end
    %unless "*"#outname#"" %then message("No output name provided","") %c
    %elsestart
!  Extend outname.
      outname=outname.".lay" %unless outname->x.(".")
!  Resolve input about ','.
      z="" %unless y->y.(",").z
      %signal %event 15 %unless y#end#z
!  Extend input.
      y=y.".lay" %unless y="" %or y->x.(".")
      z=z.".lay" %unless z="" %or z->x.(".")
      %if y="" %thenstart
        y=outname %if exists(outname)
        %exit
      %finish
    %finish
{!  If Vax.}
{    outname=fixfile(outname,defaultdir,defaultext)}
{    y=fixfile(y,defaultdir,defaultext)}
{    z=fixfile(z,defaultdir,defaultext)}
!
    %exit %if exists(y)
    message(y." does not exist","")
  %repeat
  z=",".z %unless z=""
  select input(0)  ;!  To control the editor.
{!  If Vax.}
{  z=",".z %unless z=""}
{  %if edt="vecce" %then z=y.z."/".outname %else %c}
{  %if edt="ie" %then z=y." ".outname %else %c}
{  message(edt." is an unknown editor. Please set MEMO_EDITOR.","stop")}
{  z=edt." ".z}
{  d_a=addr(z)+1; d_l=length(z)}
{  spawn(d)}
!
!  If APM.
  %if edt="vecce" %thenstart
    z=",".z %unless z=""
    memed(y.z."/".outname)
  %finishelse %c
  %if edt="ie" %thenstart
    start line=1; start position=1
    terminal model=WY 75
    set up terminal
    ie editor(y,outname,0,20,start line,start position,
    Default  Profile,Default Keyboard,Confirm!Silent!Reset Heap)
    reset terminal
  %finishelse message( %c
  edt." is an unknown editor. Please set Memo_editor to one".snl. %c
  "of VECCE or IE.","stop")
!
  select input(oldin)
%end

%routine  print letter(%record(addresseef)%name r,%record(personf)%name bcc,
%record(personlistf)%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(control)
  select output(2)
%end

%routine p label(%record(personf)%name a)
%record(line80f)%name p
%record(line80listf) b
  select output(3)
  b_head==nil; b_tail==nil
  %if "*"#a_surname#"" %thenstart
    copy address(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 x="" %else x=a_style." "
    x=x.a_initials.a_surname
    x=x." ".a_degrees %if "*"#a_degrees#""
    prune(x)
    p==newline80
    p_line=x
    prefix cell(p,b)
  %finishelsestart
    %if "*"#a_id#"" %then x=a_id %else x=""
    x=x.", Room".a_room %if ""#a_room#"*"
    %if x#"" %thenstart
      p==newline80
      p_line=x
      append cell(p,b)
    %finish
  %finish
  print label(b)
%end

%routine print letters(%record(addresseelistf)%name recips,
%record(personlistf)%name copy,bcopy)
%integer i
%record(personf)%name a
%record(line80listf) b
%record(line80f)%name p
%record(addresseef)%name r
  open output(2,letters)
  open output(3,labels)
  %if addresseeno>1 %thenstart
!  Several addressees, make up a copy list for use in print tail.
    copy_head==nil; copy_tail==nil
    r==recips_head_next
    %while r##nil %cycle
      a==newperson
      a_id=""; a_surname=r_name
      append cell(a,copy)
      r==r_next
    %repeat
    a==nil
  %finish
  r==recips_head
  select output(2)
  message("Letters will be created in ".letters,"")
  print style
  select output(3)
  print label style
  %while r##nil %cycle
    select output(2)
    print letter(r,nil,copy,bcopy,0,outname,"")
    select output(0)
    print string("Letter created for ".r_name.snl)
    select output(3)
!  Create label.
    copy address(r_b_officeaddr,b)
    p==newline80
    p_line=r_name
    prefix cell(p,b)
    print label(b)
    delete list(b)
    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 string("Copy created for FILE".snl) %if flcpy="yes"
  i=1
  %unless copy==nil %or copy_head==nil %or addresseeno>1 %thenstart
!  One addressee and 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 string("Copy created for ".full name of(a).snl)
      select output(3)
      p label(a)
      i=i+1
      a==a_next
    %repeat
  %finish
  %unless bcopy==nil %or bcopy_head==nil %or addresseeno>1 %thenstart
!  One addressee and 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 string("Copy created for ".full name of(a).snl)
      select output(3)
      p label(a)
      a==a_next
    %repeat
  %finish
  select output(2)
  print string("$E*.letter".snl."$E*".snl)
  close output
  select output(3)
  print string(snl."$E*".snl)
  close output
  select output(0)
  message("Names and addresses for labels are in ".labels,"")
%end

%routine reset ids(%record(personlistf)%name noname)
%record(personf)%name p
  p==noname_head
  %while p##nil %cycle
    p_id=p_extra_head_line %if p_extra_head##nil %and "*"#p_extra_head_line#""
    length(p_id)=length(p_id)-1 %while length(p_id)>0 %and %c
    charno(p_id,length(p_id))=sp
    p==p_next
  %repeat
%end

%routine clear surnames(%record(personlistf)%name noname)
%record(personf)%name p
  p==noname_head
  %while p##nil %cycle
    p_surname=""
    p==p_next
  %repeat
%end

%routine reset idlist(%record(personlistf)%name x)
%record(personf)%name p
  p==x_head
  %while p##nil %cycle
    p_id=p_extra_head_line
    prune and lower(p_id)
    p_surname=""
    p==p_next
  %repeat
%end

%routine get to(%record(personlistf)%name noname,%integer n,control)
!  This uses stream 3 if "@" appears in any list of recipients.
  %on %event 15 %start
    message("Stopped from input in 'get to'","stop")
  %finish
  get recipients(noname,n,control)
  identify(noname,namelist,control)
  select input(control); select output(0)
  reset ids(noname)
%end

%routine done(%integer n)
  message("Stopped while changing ".prt(n),"stop")
%end

%routine reedit
%integer addrchange,ae,at,headchange,i,n
%record(personf)%name p
%record(addresseef)%name q,r,s
%string(31) stage
%record(line80f)%name telephone,tp

%string(255) x
  %on %event 9,15 %start
    %if event_event=9 %thenstart
      select input(control)
      ->lext %if stage="ext"
      ->lsentby %if stage="sentby"
      %signal %event 9,0
    %finish
    done(n)
  %finish

  message( %c
  "For each item that may be changed you will be shown the prompt and".snl.%c
  "the current value. Respond with yes if you wish to change its value,".snl. %c
  "respond with no otherwise.","") %if first time=no
  select input(control); select output(control)
  addrchange=no
  controlp=control
  stage=""; telephone==nil
!  Letterhead.
  n=39
  print string("Change ".prt(n)."? ".letterhead.snl) %if first time=no
  %if first time=yes %or panswer(n)=yes %thenstart
    headchange=yes
    prompt(prt(n))
    skip symbol %if first time=no %and next symbol=nl
    %cycle
      get(letterhead,n)
      x=letterhead; lower(x)
      done(n) %if x=end
      letterhead=defaulthead %if letterhead="*"
{!  If Vax.}
{      letterhead=fixfile(letterhead,defaultdir,"lay")}
!
      controlp=control+1 %and %exit %if exists(letterhead)
      message(letterhead." does not exist.","")
    %repeat
    open input(controlp,letterhead)
    select input(controlp)
!  Heading.
    n=40
    input lines(heading,n)
    x=heading_head_line; lower(x)
    done(n) %if x=end
!  Sent by.
    n=10
    stage="sentby"
lsentby: get address(sent by,n)
    %if sent by_head##nil %thenstart
      x=sent by_head_line; lower(x)
      done(n) %if x=end
    %finish
    stage="telephone"
    select input(control)
!  Find lines in heading that refer to telephone (if any).
    ae=no; at=no
    tp==heading_tail
    %while tp##nil %cycle
      x=""; y=""
      z=tp_line
      lower(z)
      %if z->x.("telephone").y %thenstart
        i=1
        i=i+1 %while i<=length(y) %and %c
        (charno(y,i)=' ' %or charno(y,i)='}' %or charno(y,i)=':')
        %if i<=length(y) %and '0'<=charno(y,i)<='9' %thenstart
          at=yes
          telephone==tp
          %if y->x.("ext").y %thenstart
            ae=yes
            i=1
            i=i+1 %while i<length(y) %and %c
            (charno(y,i)=' ' %or charno(y,i)='}' %or charno(y,i)=':')
            charno(y,i-1)=length(y)-i+1
            ext=string(addr(charno(y,i-1)))
            %exit
          %finish
        %finish
      %finish
      tp==tp_prev
    %repeat
    %if at=yes %and ae=no %thenstart
      tp==heading_tail
      %while tp_prev##nil %cycle
        x=tp_line; lower(x)
        %exit %if x->x.("telephone").y
        tp==tp_prev
      %repeat
      telephone==tp
    %finish
    %if at=yes %thenstart
      %unless ae=yes %thenstart
!  Extension.
        n=7
        stage="ext"
        print string(telephone_line.snl)
lext:   get(ext,n)
        x=ext; lower(x)
        done(n) %if x=end
        stage="blank"
        telephone_line=telephone_line."  $I{Ext }".ext %if ext#"*"
      %finish
    %finish
!  Email address.
    stage="email"
!  Find line which refers to Email.
    tp==heading_tail
    %while tp##nil %cycle
      x=tp_line;lower(x)
      %exit %if x->x.("email").y
      tp==tp_prev
    %repeat
    %if tp==nil %thenstart
      get(email,47)
      x=email; lower(x)
      done(47) %if x=end
      email="$I{Email address: }".email %unless email="*"
      tp==newline80
      tp_line=email
      %if telephone==nil %thenstart
        tp_line="$B1".tp_line
        append cell(tp,heading)
      %finishelsestart
        tp_line="$B0".tp_line
        insert cell after(tp,telephone,heading)
      %finish
    %finishelse email=tp_line
  %finishelse headchange=no
  select input(control)
! My reference.
  n=16
  print string("Change ".prt(n)."? ".myrefce.snl) %if first time=no
  %if first time=yes %or panswer(n)=yes %thenstart
    prompt(prt(n))
    skip symbol %if first time=no %and next symbol=nl
    get(myrefce,n)
    x=myrefce; lower(x)
    done(n) %if x=end
  %finish
!  Addressees.
  n=37
  %if first time=no %thenstart
    print string("Change addressees? ".snl)
    %if addresseeno=0 %then q==newrecipient %and append cell(q,addressees) %c
    %else q==addressees_head
    %while q##nil %cycle
      print string(q_name.snl)
      q==q_next

    %repeat
    %if panswer(n)=yes %thenstart
      q==addressees_head
      %while q##nil %cycle
        print string("Change")
        print string(" next") %if q##addressees_head
        print string(" addressee? ".snl.q_name.",".snl)
        print address(q_b_officeaddr,":tt")
        print string(q_dear.snl)
        print string(q_truly.snl)
        s==q; q==q_next
        %if panswer(n)=yes %thenstart
          print string("Change or delete?".snl)
          %cycle
            prompt("Change/Delete: ")
            skip symbol %if next symbol=nl         ;!  Get rid of left-over NL.
            read line(x)
            lower(x)
            %exit %unless 'c'#charno(x,1)#'d'
            done(n) %if x=end
          %repeat
          %if charno(x,1)='d' %thenstart
            excise cell(s,addressees)
            addresseeno=addresseeno-1
          %finishelsestart
!  Name.
            n=1
            print string("Change name? ".s_name.snl)
            input(s_name,n) %if panswer(n)=yes
            clear recipient(s) %and %exit %if s_name=end
!  Address.
            n=0
            print string("Change address? ".snl)
            print address(s_b_officeaddr,":tt")
            %if panswer(n)=yes %thenstart
              prompt(prt(n))
              skip symbol %if first time=no %and next symbol=nl
              delete list(s_b_officeaddr)
              get address(s_b_officeaddr,n)
            %finish
            clear recipient(s) %and %exit %if s_b_officeaddr_head_line=end
!  Dear.
            n=4
            print string("Change Dear? ".s_dear.snl)
            %if panswer(n)=yes %thenstart
              prompt(prt(n))
              skip symbol %if first time=no %and next symbol=nl
              get(s_dear,n)
              prune(s_dear)
              x=s_dear; lower(x)
              clear recipient(s) %and %exit %if x=end
            %finish
!  Truly.
            n=26
            print string("Change Truly? ".s_truly.snl)
            %if panswer(n)=yes %thenstart
              prompt(prt(n))
              skip symbol %if first time=no %and next symbol=nl
              get(s_truly,n)
              prune(s_truly)
              x=s_truly; lower(x)
              clear recipient(s) %and %exit %if x=end
            %finish
            excise cell(s,addressees)
            r==addressees_head
            r==r_next %while r##nil %and r_name<=s_name
            insert cell before(s,r,addressees)
          %finish
        %finish
      %repeat
      print string("More addressees?".snl)
      get more addressees %if panswer(38)=yes
      expand address files
    %finish
  %finishelse get addressees %and addrchange=yes
  %if addresseeno=1 %thenstart
!  Your reference.
    n=25
    q==addressees_head
    print string("Change ".prt(n)."? ".q_yourrefce.snl) %if first time=no
    %if first time=yes %or panswer(n)=yes %thenstart
      prompt(prt(n))
      skip symbol %if first time=no %and next symbol=nl
      get(q_yourrefce,n)
      x=q_yourrefce; lower(x)
      done(n) %if x=end
    %finish
  %finish    ;!  Addresseeno=1.
  %if addresseeno<=1 %and addrchange=no %thenstart
    %if addresseeno=1 %then q==addressees_head %elsestart
      q==newrecipient
      append cell(q,addressees)
    %finish
!  Dear.
    n=4
    print string("Change ".prt(n)."? ".q_dear.snl) %if first time=no
    %if first time=yes %or panswer(n)=yes %thenstart
      prompt(prt(n))
      skip symbol %if first time=no %and next symbol=nl
      get(q_dear,n)
      prune(q_dear)
      x=q_dear; lower(x)
      done(n) %if x=end
    %finish
!  Truly.
    n=26
    print string("Change ".prt(n)."? ".q_truly.snl) %if first time=no
    %if first time=yes %or panswer(n)=yes %thenstart
      prompt(prt(n))
      skip symbol %if first time=no %and next symbol=nl
      get(q_truly,n)
      prune(q_truly)
      x=q_truly; lower(x)
      done(n) %if x=end
    %finish
  %finish    ;!  addresseeno<=1 %and addrchange=no.
!  Outname.
  n=15
  print string("Change ".prt(n)."? ".outname.snl) %if first time=no
  %if first time=yes %or panswer(n)=yes %thenstart
    prompt(prt(n))
    skip symbol %if first time=no %and next symbol=nl
    get body of letter(outname)
    x=outname; lower(x)
    done(n) %if x=end
  %finish
!  Headchange must be yes the first time.
  %if headchange=no %thenstart
!  Extension. If heading-file not changed.
    n=7
    print string("Change ".prt(n)."? ".ext.snl)
    %if panswer(n)=yes %thenstart
      prompt(prt(n))
      skip symbol %if next symbol=nl
      get(ext,n)
      x=ext; lower(x)
      done(n) %if x=end
    %finish
!  Email. If heading-file not changed.
    n=47
    x=email %unless email->y.("}").x
    print string("Change ".prt(n)."? ".x.snl)
    %if panswer(n)=yes %thenstart
      prompt(prt(n))
      skip symbol %if next symbol=nl
      get(email,n)
      x=email; lower(x)
      done(n) %if x=end
    %finishelse email=x
!  Sent by. If heading-file not changed.
    n=10
    print string("Change ".prt(n)."? ".snl)
    print address(sent by,"file")
    %if panswer(n)=yes %thenstart
      delete list(sent by)
      prompt(prt(n))
      skip symbol %if next symbol=nl
      get address(sent by,n)
      x=sent by_head_line; lower(x)
      done(n) %if x=end
    %finish
  %finish
  %if addresseeno<2 %thenstart
!  Cc:.
    n=2
    %if first time=no %thenstart
      print string("Change ".prt(n)."? ".snl)
      p==noname_head
      %while p##nil %cycle
        print string(p_id) %and newline %if p_id#""
        p==p_next
      %repeat
      print string("*".snl)
    %finish
    %if first time=yes %or panswer(n)=yes %thenstart
      prompt(prt(n))
      skip symbol %if first time=no %and next symbol=nl
      get recipients(noname,n,control)
!  The program is stopped within Get Recipients if .end is read.
    %finish
    reset idlist(noname)
    identify(noname,namelist,control)
    reset ids(noname)
!  Bcc:.
    n=44
    %if first time=no %thenstart
      print string("Change ".prt(n)."? ".snl)
      p==bcc_head
      %while p##nil %cycle
        print string(p_id) %and newline %if p_id#""
        p==p_next
      %repeat
      print string("*".snl)
    %finish
    %if first time=yes %or panswer(n)=yes %thenstart
      prompt(prt(n))
      skip symbol %if first time=no %and next symbol=nl
      get recipients(bcc,n,control)
!  The program is stopped within Get Recipients if .end is read.
    %finish
    reset idlist(bcc)
    identify(bcc,namelist,control)
    reset ids(bcc)
  %finish
  select input(control); select output(0)
!  Enclosures.
  n=34
  print string("Change ".prt(n)."? ".enc.snl) %if first time=no
  %if first time=yes %or panswer(n)=yes %thenstart
    prompt(prt(n))
    skip symbol %if first time=no %and next symbol=nl
    get(enc,n)
    x=enc; lower(x)
    done(n) %if x=end
  %finish
%end

{  Main Program}

!  Seqno uses input and output streams 1.

  %on %event 9,15 %start
    %signal %event 9,event_sub,dtoi(stage) %if event_event=9
    message(""".end"" or ""@"" read.","stop")
  %finish

  select input(0); select output(0)
  addresseeno=0; addressees_head==nil; addressees_tail==nil
  ae=no; at=no
  bcc_head==nil; bcc_tail==nil
  control=0
  copy values_head==nil; copy values_tail==nil
  p==newline80; p_line="yes"; append cell(p,copy values)
  p==newline80; p_line="no"; append cell(p,copy values)
  set up(flcpy,file copy,"yes",copymess,copyvalues)
  editors_head==nil; editors_tail==nil
  p==newline80; p_line="vecce"; append cell(p,editors)
  p==newline80; p_line="ie"; append cell(p,editors)
  set up(edt,editor,"vecce",edmess,editors)
  enc="*"; ext="*"
  heading_head==nil; heading_tail==nil
  linewidth=labelwidth-2*leftmargin
  noname_head==nil; noname_tail==nil
  printdepth=labeldepth-2*topmargin
  sent by_head==nil; sent by_tail==nil
  stage="start"
  select input(0); select output(0)
  telephone==nil
  tolaser=yes; labelstolaser=no
  message("Type ""?"" for HELP, "".end"" to abandon.","")
  controlp=control
  select input(control)
  first time=yes
  reedit
  first time=no
  stage="29"
  %if control=0 %thenstart
    %cycle
      message( %c
      "You may change any item by answering ""yes"" to the next prompt.","")
      prompt(prt(29))
      %exit %if panswer(29)=no
      reedit
!  Find the line with the telephone number.
      telephone==heading_head
      %while telephone##nil %cycle
        %if telephone_line->("telephone").x %thenstart
          telephone_line=telephone_line."  $I{Ext }".ext %and %exit %if ext#"*"
          %exit
        %finish
        telephone==telephone_next
      %repeat
!  Find the line for the Email address.
      stage="47"
      s==heading_head
      %while s##nil %cycle
        %if s_line->("Email").x %thenstart
          s_line="$B1$I{Email address }".email %and %exit %if email#"*"
          %exit
        %finish
        s==s_next
      %repeat
      %if s==nil %and email#"*" %thenstart
        s==newline80
        s_line="$B1$I{Email Address: }".email
        %if telephone==nil %then append cell(s,heading) %c
        %else insert cell after(s,telephone,heading)
      %finish
    %repeat    {enquiry about editing.}
  %finish             {of  control=0}
  select input(control)
  prompt(prt(30))
  print string(snl.prt(30).snl)
  tolaser=panswer(30)
  prompt(prt(48))
  print string(snl.prt(48).snl)
  labelstolaser=panswer(48)
  labels=""; letters=""
!  If APM.
  labels="lp2:"  %if labelstolaser=yes
  letters="lp2:" %if tolaser=yes
!
  letters=letters."x".seqno.".lay"
  labels=labels."x".seqno.".lay"
  print letters(addressees,noname,bcc)
{!  If Vax.}
{  %if tolaser=yes %or labelstolaser=yes %thenstart}
{    command="comm".seqno.".com"}
{    open output(3,command)}
{    select output(3)}
{    %if tolaser=yes %thenstart}
{      print string("$@u0:[sm.office]las ".letters.snl)}
{      print string("$delete ".letters.";*".snl)}
{    %finish}
{    %if labelstolaser=yes %thenstart}
{      print string("$@u0:[sm.office]las ".labels.snl)}
{      print string("$delete ".labels.";*".snl)}
{    %finish}
{    close output}
{    select output(0)}
{    x="@".command}
{    d_a=addr(x)+1; d_l=length(x)}
{    spawn(d)}
{    delete(command)}
{  %finish}
!
!  If APM.
  message("Letters sent to laser printer.","") %if tolaser=yes
!


%endofprogram
