

   CS IMP Compiler for M68000.  Version  3.0d

   LATEST  compiled on 12/11/87  at  17.52

    1  
    2  
    3  
    4  {  12/11/87  09:52   latest}
    5  
    6  %include "sm:consts.inc"
    7  %include "sm:formats.inc"
    8  %include "sm:menus.inc"
    9  %include "sm:persons.inc"
   10  %include "sm:utils.inc"
?  54& Nonstandard 9   %externalstring(255)%fnspec translate command symbol(%string(*) s)
   11  %include "sm:vti.inc"
   12  
   13  %externalroutine receive broadcast
   14  !  To keep IE happy.
   15  %end
   16  
   17  %begin
   18  
   19  ! If APM.
   20  %include "sm:util.inc"
   21  %include "sm:run.inc"
?   8& Low level       |@16_117c %integerfn defname(%string(255)s,%record(dictf)%name d,%integer size)
   22  %include "ie:ie.inc"
   23  %include "inc:fs.imp"
   24  %include "inc:fsutil.imp"
   25  !
   26  %externalroutinespec reset terminal %alias "IE_RESET_TERMINAL"
   27  %externalroutinespec set up terminal %alias "IE_SET_UP_TERMINAL"
   28  %externalbytespec Terminal Model %alias "IE_TT_MODEL"
   29  
   30  %recordformat addresseef(%record(addresseef)%name next,prev,
   31+ %record(personf) b,
   32+ %string(31) dear,
   33+ %string(80) name,
   34+ %string(31) yourrefce,
   35+ %string(31) yours)
   36  %recordformat addresseelistf(%record(addresseef)%name head,tail)
   37  %integer addresseeno=0
   38  %record(addresseelistf) addressees
   39  %constinteger addressflag=16_80      ;!  Flag for reedit.
   40  %record(line80listf) bcc
   41  %record(line80listf) cc
   42  %constreal chperinch=12        ;!  Characters per inch for font Times10.
   43  %routinespec collect recipients(%record(line80listf)%name u)
   44  {!  If Vax}
   45  {%ownstring(63) command=""       ;!  Name of command file to be created.}
   46  !
   47  %integer create labels=0
   48  %record(dataf)%array data(0:31)
   49  {!  If Vax.}
   50  {%recordformat df(%integer l, a)}
   51  {%record(df) d}
   52  {%conststring(3) defaultext="imp"}
   53  {%ownstring(31) defaulthead="U0:[sm.head]department.lay"}
   54  {%externalintegerfnspec do command %alias "LIB$DO_COMMAND"(%record(df)%name d)}
   55  {%externalintegerfnspec spawn %alias "LIB$SPAWN"(%record(df)%name d)}
   56  {%externalstring(255)%fnspec translate(%string(*)%name s)}
   57  !
   58  !  If APM.
   59  %ownstring(31) defaulthead="office:department"
   60  !
   61  %constinteger dearflag=16_400   ;!  Flag for reedit.
   62  %ownstring(31) defaultdear=""
   63  {!  If Vax.}
   64  {%ownstring(31) defaultdir="U0:[KBD]"}
   65  !
   66  !  If APM.
   67  %ownstring(31) defaultdir="office:"
   68  !
   69  %ownstring(31) defaultyours=""
   70  %record(line80listf) editors
   71  {!  If Vax.}
   72  {%conststring(3) editext="lay"}
   73  !
   74  !  If APM.
   75  %conststring(3) editext=""
   76  !
   77  %conststring(255) edmess= %c
   78+ "Only VECCE and IE are currently known to Letters.
   79" Please assign one of these to LETTER_EDITOR in your login.com file."
   80  %string(15) edt=""
   81  %string(63) email=""
   82  %string(255) enc=""
   83  %string(255) ext=""
   84  %ownstring(31) fax="031 667 7938"
   85  %integer flag=0, flag7=0, flag15=0, flag16=0, flag17=0
   86  %string(7) flcpy=""
   87  %record(line80listf) heading
   88  %owninteger horizlabels=2       ;!  Maximum number of labels across the page.
   89  %integer i,j
   90  %constreal indent=0.2           ;!  Left-hand margin on each label in inches.
   91  %constreal labeldepth=1.575     ;!  Depth of a label in inches.
   92  %recordformat labelf(%record(labelf)%name next,prev,%record(line80listf) b)
   93  %recordformat labellistf(%record(labelf)%name head,tail)
   94  %record(labellistf) label list
   95  %string(31) labels=""
   96  %integer labelstolaser=0
   97  %constreal labelwidth=3.741     ;!  Width of a label in inches.
   98  %constreal leftmargin=0.2       ;!  Margin at left of a label.
   99  %string(31) letterhead=""
  100  {!  If Vax.}
  101  {%conststring(31) letterhelp="u0:[sm.office]letterhelp.imp"}
  102  !
  103  !  If APM.
  104  %conststring(31) letterhelp="office:letterhelp"
  105  !
  106  %string(31) letters=""
  107  %conststring(13) lett="letters_"
  108  %ownreal linewidth=79
  109  %constreal linesperinch=6       ;!  Lines per inch for Times10.
  110  %integerarray menu1(0:250)       ;!  To hold the item numbers for the menu.
  111  %string(31) myrefce=""
  112  !  If APM.
  113  %conststring(31) namelist="sm:persdata"
  114  !
  115  %constinteger nameflag=16_100   ;!  Flag for reedit.
  116  {!  If Vax.}
  117  {%conststring(31) namelist="u0:[sm.office]persdata.imp"}
  118  !
  119  %record(line80listf) nillist
  120  %string(255) outname=""
  121  %ownreal printdepth=0
  122  %ownstring(15) printer="lp2"
  123  %ownrecord(line80listf) printerlist
  124  %ownstring(255) printmess= %c
  125+ "Newletts knows about  lp2 and lp3. Please assign one of these
  126" to LETTERS_PRINTER."
  127  %record(line80listf) star
  128  %record(line80listf) sent by
  129  %integer stage=0
  130  %string(31) telephone number=""
  131  %string(31) telex=""
  132  %integer tolaser=0
  133  %constreal top=0.342            ;!  Margin at top of page of labels.
  134  %constreal topmargin=0.2        ;!  Margin at top of label.
  135  {!  If Vax.}
  136  {%constinteger tracechan=7}
  137  !
  138  !  If APM.
  139  %constinteger tracechan=1
  140  !
  141  %string(31) u=""
  142  %externalstring(12)%fnspec username
  143  %ownstring(19)%array var(0:31)=
  144  "Create output",        { 0}
  145+ "heading",              { 1}
  146+ "telex",                { 2}
  147+ "telephone_number",     { 3}
  148+ "extension",            { 4}
  149+ "email",                { 5}
  150+ "my_reference",         { 6}
  151+ "addressees",           { 7}
  152+ "name",                 { 8}
  153+ "address",              { 9}
  154+ "default dear",         {10}
  155+ "your_reference",       {11}
  156+ "editor",               {12}
  157+ "letter_file",          {13}
  158+ "default yours",        {14}
  159+ "sent_by",              {15}
  160+ "cc",                   {16}
  161+ "bcc",                  {17}
  162+ "enclosure",            {18}
  163+ "file_copy",            {19}
  164+ "print_letters",        {20}
  165+ "create_labels",        {21}
  166+ "print_labels",         {22}
  167+ "printer",              {23}
  168+ "directory",            {24}
  169+ "fax",                  {25}
  170+ "",                     {27}
  171+ "",                     {27}
  172+ "",                     {28}
  173+ "",                     {29}
  174+ "",                     {30}
  175+ "Abandon"               {31}
  176  %owninteger vertlabels=7        ;!  Maximum number of labels down the page.
  177  %externalroutinespec view(%string(255) file,topic)
  178  %record(line80listf) yesnostar
  179  %string(80) yesnomess= %c
  180+ "Only  y  and  n  and  *  and  .end  are legitimate responses."
  181  %constinteger yoursflag=16_4000 ;!  Flag for reedit.
  182  
  183  %record(labelf)%map newlabel
  184  %record(labelf)%name p
  185  %record(labelf) pattern
  186    p==new(pattern)
  187    p_next==nil; p_prev==nil
  188    p_b_head==nil; p_b_tail==nil
  189    %result==p
  190  %end
  191  
  192  %routine print line(%string (255) s)
  193    printstring(s)
  194    newline
  195  %end
  196  
  197  %routine destroy(%string(255) s)
  198  {!  If Vax.}
  199  {%string(255) u,v}
  200  !
  201  
  202    %on %event 1,2,3,4,5,6,7,8,9,10,11,12,13,14 %start
  203      trace("Event ".itod(event_event).",".itod(event_sub)."  ".Event_message)
  204      %return
  205    %finish
  206  
  207  {!  If Vax.}
  208  {  s=s.";" %unless s->u.(";").v}
  209  !
  210    delete(s)
  211  %end
  212  
  213  %routine insert list before(%record(line80listf)%name u,%record(line80f)%name p,
  214+ %record(line80listf)%name v)
  215  %record(line80f)%name q,r
  216    %return %if u==nil %or u_head==nil
  217    q==u_head
  218    %while q##nil %cycle
  219      r==newline80
  220      r_line=q_line
  221      %if p==nil %then append cell(r,v) %else insert cell before(r,p,v)
  222      q==q_next
  223    %repeat
  224  %end
  225  
  226  %routine h(%integer stage)
  227  %string(255) topic,x,y
  228    %if 0<=stage<=31 %then topic=var(stage) %else topic=""
  229    topic=x." ".y %while topic->x.("_").y
  230    view(letterhelp,topic)
  231  %end
  232  
  233  %routine remove(%record(*)%name p,l)
  234    excise cell(p,l)
  235    dispose(p)
  236  %end
  237  
  238  %routine copy lines(%record(line80listf)%name a,b)
  239  %record(line80f)%name p,q
  240    b_head==nil; b_tail==nil
  241    p==a_head
  242    %while p##nil %cycle
  243      q==newline80
  244      q_line=p_line
  245      append cell(q,b)
  246      p==p_next
  247    %repeat
  248  %end
  249  
  250  %routine clear recipient(%record(addresseef)%name r)
  251    r_next==nil; r_prev==nil
  252    r_dear=""; r_name=""; r_yours=""; r_yourrefce=""
  253    clear person(r_b)
  254  %end
  255  
  256  %record(addresseef)%map newrecipient
  257  %record(addresseef) recippattern
  258  %record(addresseef)%name p
  259    p==new(recippattern)
  260    clear recipient(p)
  261    %result==p
  262  %end
  263  
  264  %string(255)%fn full name of(%record(personf)%name a)
  265  %string(255) u,v
  266    %if a##nil %thenstart
  267      %if "*"#a_surname#"" %thenstart
  268        u=a_surname %unless a_surname->u.(",").v %and v=""
  269        %if "*"#a_style#"" %then v=a_style." " %else v=""
  270        v=v.a_initials %if "*"#a_initials#""
  271        u=v.u
  272      %finishelse u=""
  273      u=a_id %if u=""
  274    %finishelse u=""
  275    %result=u
  276  %end
  277  
  278  !  This discards leading blank lines and spaces.
  279  !  It returns ".end" if '.end' or <EOF> is encountered.
  280  
  281  %routine read word(%string(*)%name a)
  282  %integer j
  283  %string(255) x
  284    %on %event 9 %start
  285      a=end
  286      %return
  287    %finish
  288    skip symbol %while next symbol=sp %or next symbol=nl
  289    a=""
  290    read symbol(j) %and a=a.tostring(j) %while sp#next symbol#nl
  291    x=a
  292    lower(x)
  293    a=x %if x=end
  294  %end
  295  
  296  !  This uses input stream 3.
  297  
  298  %routine append text(%string(255) s)
  299  %integer i,oldin
  300    %on %event 9 %start
  301      close input %if instream#0
  302      select input(oldin)
  303      %return
  304    %finish
  305    oldin=instream
  306    open input(3,s)
  307    select input(3)
  308    %cycle
  309      read symbol(i)
  310      print symbol(i)
  311    %repeat
  312  %end
  313  
  314  %routine print recipient(%record(addresseef)%name r,%string(255) s)
  315    print line(snl.s) %unless s=""
  316    print line("Id=".r_b_id)
  317    %return %if r_b_id=end
  318    print line(r_name.",")
  319    print address(r_b_officeaddr,":tt")
  320    print line("Dear ".r_dear)
  321    print line("Yours ".r_yours)
  322  %end
  323  
  324  %routine print style
  325    print line("$D #='$K163'")
  326    print line("$D.var pageno,top")
  327    print line("$D.format pages")
  328    print line("=$pageno=pageno+1")
  329    print line("=$Q(2-pageno)$O0.2"",Y,6.85"",0[]")
  330    print line("=$Q(pageno-1)$B0.1""$Times12{$v(pageno)}$B>0")
  331    print line("=$Q(pageno-1)$O0.2"",0.5"",6.85"",-0.5""[]")
  332    print line("=$C")
  333    print line("=$pages")
  334    print line("$Z.include office:crest")
  335    print line("$S*.letter")
  336  %end
  337  
  338  %routine print form(%record(line80f)%name bcc,%string(7) file)
  339  %string(255) u
  340    print line("$M0.5"",0,7.2"",11""")
  341    print line("$X0$Y0")
  342    print line("$T=0.5"",1"",1.5"",2"",2.5"",". %c
  343+   "3"",3.5"",4"",4.5"",5"",5.5"",6"",6.5"",7"",7.5"",8""")
  344    print line("$L=0.2""?$G=2$I=3$J0")
  345    print line("$pageno=0")
  346    %if file="file" %then u="FILE COPY" %else %c
  347+   %if file="bcc" %then u="Copy for ".bcc_line %else u=""
  348    print line("$Times12")
  349    %if u="" %then print line("$B1") %else print line("$H{".u."}$B^0")
  350    print line("$top=Y")
  351    print address(heading,"")
  352    %if "*"#telephone number#"" %or "*"#telex#"" %or "*"#fax#"" %thenstart
  353      print string("$B0.05""")
  354      %if "*"#telephone number#"" %thenstart
  355        print string("$I{Telephone:} ".telephone number)
  356        print string(" $I{Ext: }".ext ) %if "*"#ext#""
  357      %finish
  358  !  $T0 is to delimit the text to be right-justified.
  359      print string(snl."$T0$I{Telex: }".telex."$X>7""") %if "*"#telex#""
  360      print string(snl."$B0.05""$I{Email: }".email) %if "*"#email#""
  361  !  $T0 is to delimit the text to be right justified.
  362      print string(snl."$T0$I{Fax: }".fax."$X>7""") %if "*"#fax#""
  363      print string("$B0")
  364      newline
  365    %finish
  366    print line("$Times12")
  367    print line("$pages")
  368  %end
  369  
  370  %routine print head(%record(addresseef)%name r,%record(line80f)%name bcc,
  371+ %string(7) file)
  372  %string(255) u,v
  373    print form(bcc,file)
  374    %if r##nil %thenstart
  375      print string("$B0")
  376      print string("$I{My reference: }".myrefce) %if "*"#myrefce#""
  377  !  $T0 is to delimit the text to be right-justified.
  378      print string("$T0$I{Your reference: }".r_yourrefce."$B>0") %c
  379+     %if "*"#r_yourrefce#""
  380      newline %if "*"#myrefce#"" %or "*"#r_yourrefce#""
  381      print string("$B1 ".r_name.",$T0 ".ddate."$B>0".snl)
  382      print address(r_b_officeaddr,"layout")
  383      print string("$B0")
  384      r_dear=defaultdear %if r_dear=""
  385      %if "*"#r_dear#"" %thenstart
  386        print string("Dear ".r_dear)
  387        print string(",") %unless r_dear->u.(",").v %and v=""
  388        newline
  389        print string("$B0")
  390      %finish
  391    %finishelse print string("$B0.3""$T0 ".ddate."$X>7""".snl."$B0.25""".snl)
  392    print string("$L1$J1".snl)    ;!  Set line-filling ON and Justification ON.
  393  %end
? 393  U underused     %end
  394  
  395  %routine print copy list(%record(line80listf)%name copy,%string(31) c,
  396+ %integer arrow)
  397  %integer p
  398  %string(80) u
  399  %record(line80f)%name a
  400    %if copy##nil %and copy_head##nil %c
  401+   %and copy_head_line#"*" %and copy_head_line#"" %thenstart
  402      print string("$B0".snl)
  403      print string("$B1".c) %if c#""
  404      p=1
  405      a==copy_head
  406      %while a##nil %cycle
  407        u=a_line
  408        %if p=arrow %then u="$T0 ->$T>1 ".u %else u="$T1 ".u
  409        print string(u."$B0".snl)
  410        p=p+1
  411        a==a_next
  412      %repeat
  413    %finish
  414  %end
  415  
  416  %routine print names(%record(addresseelistf)%name a)
  417  %record(addresseef)%name p
  418  %string(80) u
  419    %return %if a==nil %or a_head==nil
  420    print string("$B1 Also sent to:- ")
  421    print string("$T*2")
  422    p==a_head
  423    %while p##nil %cycle
  424      u=full name of(p_b)
  425      print string(u)
  426      p==p_next
  427      print string(",") %unless p==nil
  428      newline
  429    %repeat
  430    newline
  431    print string("$B1$T*0".snl)
  432  %end
  433  
  434  %routine print tail(%record(addresseef)%name r,
  435+ %record(line80listf)%name copy,bcopy,%integer arrow,%string(7) file)
  436  %integer lines
  437  %real c
  438  %string(255) u,v
  439  %record(line80f)%name p
  440    print string("$Times12".snl)
  441    print string("$T*0".snl)
  442    lines=0
  443    p==sent by_head
  444    lines=lines+1 %and p==p_next %while p##nil
  445    r_yours=defaultyours %if r_yours=""
  446    %if r##nil %and "*"#r_yours#"" %thenstart
  447      c=1.2+lines/5
  448      print string("$B0.2""".snl)
  449      print string("Yours ".r_yours)
  450      print string(",") %unless r_yours->u.(",").v %and v=""
  451      print string("$B^0".snl)
  452    %finish
  453    %if sent by_head##nil %thenstart
  454      print string("$B0.75""")
  455      print address(sent by,"centre")
  456    %finish
  457    print string("$B1 Encl:- ".enc.snl) %if "*"#enc#""
  458    print copy list(copy,"cc:",arrow)
  459    %if file="file" %thenstart
  460      print copy list(bcopy,"bcc:",arrow)
  461      print names(addressees) %if addresseeno>1
  462    %finish
  463    print string("$E*".snl)
  464  %end
? 464  U underused     %end
? 464  C underused     %end
  465  
  466  %routine xedit(%string(*)%name a)
  467  %string(63) u,w
  468  !  If APM.
  469  %integer start line,start position
  470  !
  471  {!  If Vax.}
  472  {%record(df) d}
  473  {%integer flag}
  474  !
  475    clear frame
  476    a=u.w %while a->u.("_").w %or (edt="vecce" %and a->u.(" ").w)
? 476  Out of range    a=u.w %while a->u.("_").w %or (edt="vecce" %and a->u.(" ").w)
  477    %if edt="vecce" %thenstart
  478      w="*" %unless a->a.("/").w
? 478  Out of range    w="*" %unless a->a.("/").w
  479      u="" %unless a->a.(",").u
? 479  Out of range    u="" %unless a->a.(",").u
  480      u=fix file(u,defaultdir,editext)
  481      a=fix file(a,defaultdir,editext)
  482      %if w="*" %thenstart
  483        w=a
  484        a="" %unless exists(a)
  485      %finishelse %c
  486+     %if w="" %then w=a %else w=fix file(w,defaultdir,editext)
  487      a="No name given for document." %and %return %if w=""
  488      a=a.",".u %unless u=""
  489      a=a."/".w
  490  {!  If Vax.}
  491  {    a=edt." ".a}
  492  {    d_a=addr(a)+1; d_l=length(a)}
  493  {    flag=spawn(d)}
  494  !
  495  !  If APM.
  496      set video mode(screen mode+special pad)
  497      memed(a)
  498  !
  499    %finishelse %if edt="ie" %thenstart
  500      w="" %unless a->a.(" ").w %or a->a.("/").w
? 500  Out of range    w="" %unless a->a.(" ").w %or a->a.("/").w
  501      a=fix file(a,defaultdir,editext)
  502      %if w="" %then w=a %else w=fix file(w,defaultdir,editext)
  503      a=a." ".w
  504  {!  If Vax.}
  505  {    u=edt." ".a}
  506  {    d_a=addr(u)+1; d_l=length(u)}
  507  {    flag=spawn(d)}
  508  {    message("Flag from ".u."=".itoh(flag),"") %if flag&1=0}
  509  {    start screen mode}
  510  !
  511  !  If APM.
  512      start line=1; start position=1
  513      terminal model=6
  514      set up terminal
  515      a=u.w %while a->u.(" ").w
? 515  Out of range    a=u.w %while a->u.(" ").w
  516      ie editor(a,a,0,20,start line,start position,
  517+     Default  Profile,Default Keyboard,Confirm!Silent!Reset Heap)
  518      reset terminal
  519  !
  520    %finishelse message("You are trying to use ".Edt.".".snl.edmess,"stop")
  521    a=w
  522    select input(0); select output(0)
  523    prompt("")
  524    set video mode(screenmode+special pad)
  525  %end
  526  
  527  %routine trim trailing commas and spaces(%string(*)%name a)
  528    length(a)=length(a)-1 %while length(a)>0 %c
  529+   %and (charno(a,length(a))=',' %or charno(a,length(a))=sp)
  530  %end
  531  
  532  %routine trim address(%record(line80listf)%name address)
  533  %record(line80f)%name p,q
  534    p==address_head
  535    %while p##nil %cycle
  536      trim trailing commas and spaces(p_line)
  537      q==p
  538      p==p_next
  539      excise cell(q,address) %and dispose(q) %if q_line=""
  540    %repeat
  541    %if address_tail##nil %thenstart
  542      p==address_tail
  543      length(p_line)=length(p_line)-1 %while length(p_line)>0 %c
  544+     %and charno(p_line,length(p_line))='.'
  545    %finish
  546  %end
  547  
  548  %routine read line(%string(*)%name a)
  549  %integer j
  550    a=""
  551    %while next symbol#nl %cycle
  552      read symbol(j)
  553      a=a.tostring(j)
  554    %repeat
  555    skip symbol    ;!  To get rid of nl.
  556  %end
  557  
  558  %routine read lines(%record(line80listf)%name a)
  559  %record(line80f)%name p
  560  %string(255) u,v
  561    a_head==nil; a_tail==nil
  562    %cycle
  563      skip symbol %while next symbol=sp
  564      read line(u)
  565      v=u; lower(v)
  566      screen message("Stopped while changing ".var(stage),"stop") %if v=end
  567      %exit %if v="*"
  568      p==newline80
  569      p_line=u
  570      append cell(p,a)
  571    %repeat
  572  %end
  573  
  574  %routine read screen lines(%record(line80listf)%name a)
  575  %record(line80f)%name p
  576  %string(255) u
  577    skip symbol %while next symbol=sp %or next symbol=rt
  578    %cycle
  579      read screen line(u)
  580      %exit %if u="*"
  581      p==newline80
  582      p_line=u
  583      append cell(p,a)
  584    %repeat
  585  %end
  586  
  587  %routine collect(%string(*)%name a)
  588  %string(63) u
  589    read screen line(a)
  590    u=a; lower(u)
  591    screen message("Stopped while changing ".var(stage),"stop") %if u=end
  592  %end
  593  
  594  %routine collect lines(%record(line80listf)%name a)
  595  %string(63) u,v,w
  596  %record(line80f)%name p
  597  
  598    %on %event 9 %start
  599      message("Stopped while changing ".var(stage),"stop")
  600    %finish
  601  
  602    clear frame
  603    select input(0)
  604    v=var(stage).".imp"
  605    v=u.w %while v->u.("_").w %or v->u.(" ").w
  606    open output(3,v); select output(3)
  607    p==a_head
  608    %while p##nil %cycle
  609      print string(p_line.snl) %if p_line#"*"
  610      p==p_next
  611    %repeat
  612    print string("*".snl)
  613    close output
  614    select input(0); select output(0)
  615    delete list(a)
  616    xedit(v)
  617    open input(3,v); select input(3)
  618    read lines(a)
  619    close input %if instream#0
  620    select input(0)
  621    destroy(v)
  622  %end
  623  
  624  !  This requires Name, Address, Dear and Yours.
  625  !  It fills in the Default values for Dear and Yours if * is read.
  626  !  The Default values may be null.
  627  
  628  %routine get addressee(%record(addresseef)%name r)
  629  %integer oldstage
  630  %string(63) u
  631  
  632    %on %event 9,15 %start
  633      message("stopped while changing ".var(stage),"stop") %c
  634+     %if event_event=15 %and event_sub=1
  635      close input %and select input(0) %if event_event=9 %and instream#0
  636      clear recipient(r)
  637      stage=oldstage
  638      %return
  639    %finish
  640  
  641    r_b_id=""    ;!  Clear recipient sets r_b_id to end.
  642    oldstage=stage
  643  !  Input name of addressee
  644    stage=8
  645    skip symbol %while next symbol=sp %or next symbol=nl
  646    read line(u)
  647    prune(u)
  648    r_b_id=u; r_name=u
  649    %signal %event 15,2 %if u="*"  ;!  No more addressees.
  650    stage=oldstage %c
  651+   %and %return %if length(u)>0 %and charno(u,1)='@'    ;!  File name.
  652  !  Get address of addressee.
  653    stage=9
  654    read lines(r_b_officeaddr)
  655    trim address(r_b_officeaddr)
  656  !  Dear.
  657    stage=10
  658    read line(r_dear)
  659    r_dear=defaultdear %if r_dear=""
  660  !  Yours.
  661    stage=14
  662    read line(r_yours)
  663    r_yours=defaultyours %if r_yours=""
  664    stage=oldstage
  665  %end
  666  
  667  %routine get more addressees
  668  %record(addresseef)%name r
  669    %cycle
  670      r==newrecipient
  671      get addressee(r)
  672      %exit %if r_b_id=end
  673      append cell(r,addressees)
  674      addresseeno=addresseeno+1
  675    %repeat
  676    dispose(r)
  677  %end
  678  
  679  %routine expand address files
  680  %record(addresseef)%name p,q,r
  681  %string(255) u
  682    select input(0)
  683  !  Expand any filenames into addressees.
  684    p==addressees_head
  685    %while p##nil %cycle
  686      %if p_name->("@").u %thenstart
  687  !  Report if file does not exist.
  688        %if %not exists(u) %then p_name=u." does not exist." %else %c
  689+       open input(3,u)
  690        select input(3)
  691  !  This inserts the new addressees after p in the list of addressees
  692        %cycle
  693          r==newrecipient
  694          get addressee(r)
  695          %exit %if r_b_id=end
  696          insert cell after(r,p,addressees)
  697          addresseeno=addresseeno+1
  698        %repeat
  699        dispose(r)    ;!  Because r_b_id=end.
  700        close input %if instream#0
  701        select input(0)
  702        q==p; p==p_next
  703        excise cell(q,addressees)
  704        dispose(q)
  705        addresseeno=addresseeno-1
  706      %finishelse p==p_next
  707    %repeat
  708  %end
  709  
  710  %routine get addressees
  711    addresseeno=0
  712    addressees_head==nil; addressees_tail==nil
  713    get more addressees
  714    expand address files
  715    stage=7
  716  %end
  717  
  718  %routine  print letter(%record(addresseef)%name r,%record(line80f)%name bcc,
  719+ %record(line80listf)%name copy,bcopy,%integer arrow,%string(31) outname,
  720+ %string(7) file)
  721    select output(2)
  722    print head(r,bcc,file)
  723    append text(outname) %if exists(outname)
  724    print tail(r,copy,bcopy,arrow,file)
  725    select input(0)
  726    select output(2)
  727  %end
  728  
  729  %routine list label(%record(line80listf)%name b)
  730  %record(labelf)%name lbl
  731    %return %if b==nil
  732    lbl==new label
  733    copy lines(b,lbl_b)
  734    append cell(lbl,label list)
  735  %end
  736  
  737  %routine p label(%record(personf)%name a)
  738  %record(line80f)%name p
  739  %record(line80listf) b
  740  %string(255) u
  741    select output(3)
  742    b_head==nil; b_tail==nil
  743    %if "*"#a_surname#"" %thenstart
  744      copy lines(a_officeaddr,b)
  745      %if "*"#a_department_line#"" %thenstart
  746        p==newline80
  747        p_line=a_department_line
  748        prefix cell(p,b)
  749      %finish
  750      %if a_style="" %or a_style="*" %then u="" %else u=a_style." "
  751      u=u.a_initials.a_surname
  752      u=u." ".a_degrees %if "*"#a_degrees#""
  753      prune(u)
  754      p==newline80
  755      p_line=u
  756      prefix cell(p,b)
  757    %finishelsestart
  758      %if "*"#a_id#"" %then u=a_id %else u=""
  759      u=u.", Room".a_room %if ""#a_room#"*"
  760      %if u#"" %thenstart
  761        p==newline80
  762        p_line=u
  763        append cell(p,b)
  764      %finish
  765    %finish
  766    list label(b)
  767    delete list(b)
  768  %end
  769  
  770  %routine print letters(%record(addresseelistf)%name recips,
  771+ %record(line80listf)%name copy,bcopy)
  772  %integer i
  773  %record(line80listf) b
  774  %record(labelf)%name lbl
  775  %record(line80f)%name a,p
  776  %record(addresseef)%name r
  777  %record(personf)%name c
  778  %record(personlistf) d
  779    select output(0)
  780    print line("LETTERS WILL BE CREATED IN ".letters)
  781    open output(2,letters)
  782    select output(2)
  783    print style
  784    %if create labels=yes %thenstart
  785      select output(0)
  786      print line("LABELS WILL BE CREATED IN ".LABELS)
  787      d_head==nil; d_tail==nil
  788    %finish
  789    select output(2)
  790    r==recips_head
  791    %while r##nil %cycle
  792      print letter(r,nil,copy,bcopy,0,outname,"")
  793      select output(0)
  794      print line("Letter created for ".r_name)
  795      select output(2)
  796  !  Create label.
  797      %if create labels=yes %thenstart
  798        copy lines(r_b_officeaddr,b)
  799        p==newline80
  800        p_line=r_name
  801        prefix cell(p,b)
  802        list label(b)
  803        delete list(b)
  804      %finish
  805      r==r_next
  806    %repeat
  807    select output(2)
  808    r==recips_head
  809    print letter(r,nil,copy,bcopy,-1,outname,"file") %and %c
  810+   select output(0) %and %c
  811+   print line("Copy created for FILE") %if flcpy="y"
  812    i=1
  813    %unless copy==nil %or copy_head==nil %c
  814+   %or copy_head_line="*" %or copy_head_line="" %thenstart
  815  !  There is a list for cc:.
  816      r==recips_head
  817      a==copy_head
  818      %while a##nil %cycle
  819        select output(2)
  820        print letter(r,nil,copy,bcopy,i,outname,"copy")
  821        select output(0)
  822        print line("Copy created for ".a_line)
  823        i=i+1
  824        a==a_next
  825      %repeat
  826    %finish
  827    %unless bcopy==nil %or bcopy_head==nil %c
  828+   %or bcopy_head_line="*" %or bcopy_head_line=""  %thenstart
  829  !  There is a list for bcc:.
  830      r==recips_head
  831      a==bcopy_head
  832      %while a##nil %cycle
  833        select output(2)
  834        print letter(r,a,copy,bcopy,0,outname,"bcc")
  835        select output(0)
  836        print line("Copy created for ".a_line)
  837        a==a_next
  838      %repeat
  839    %finish
  840    select output(2)
  841    print line("$E*.letter".snl."$E*")
  842    close output
  843    %if create labels=yes %thenstart
  844      concat lists(copy,bcopy)
  845      a==copy_head
  846      %while a##nil %cycle
  847        c==newperson
  848        c_id=a_line
  849        append cell(c,d)
  850        a==a_next
  851      %repeat
  852      identify(d,namelist,0)
  853      c==d_head
  854      %while c##nil %cycle
  855         p label(c)
  856         c==c_next
  857      %repeat
  858      select output(3)
  859      i=0; lbl==label list_head
  860      %while lbl##nil %cycle
  861        i=i+1
  862        lbl==lbl_next
  863      %repeat
  864      %if i>0 %thenstart
  865        i=i//(horizlabels*vertlabels); i=1 %if i=0
  866        open output(3,labels); select output(3)
  867        print string("$Z.pause Insert ".itod(i)." sheets of labels.".snl)
  868        print label style
  869        lbl==label list_head
  870        %while lbl##nil %cycle
  871          print label(lbl_b)
  872          lbl==lbl_next
  873        %repeat
  874        print string(snl."$E*".snl)
  875        close output
  876        select output(0)
  877        print string("NAMES AND ADDRESSES FOR LABELS ARE IN ".labels)
  878        newline
  879        delete list(label list)
  880      %finish
  881    %finish
  882    select output(0)
  883  %end
  884  
  885  %routine separate ids(%record(line80listf)%name l)
  886  %record(line80f)%name p,q
  887  %string(63) u,w
  888    p==l_head
  889    %while p##nil %cycle
  890      w=p_line
  891      %while w#"" %cycle
  892        u=w %and w="" %unless w->u.(";").w
  893        q==newline80
  894        q_line=u
  895        insert cell before(q,p,l)
  896      %repeat
  897      q==p
  898      p==p_next
  899      excise cell(q,l)
  900      dispose(q)
  901    %repeat
  902  %end
  903  
  904  %routine expand id files(%record(line80listf)%name l)
  905  %record(line80f)%name p,q
  906  %record(line80listf) u
  907  %string(31) f
  908    p==l_head
  909    %while p##nil %cycle
  910      %if p_line->("@").f %thenstart
? 910  Out of range    %if p_line->("@").f %thenstart
  911        open input(3,f); select input(3)
  912        collect recipients(u)
  913        close input; select output(0)
  914        insert list before(u,p,l)
  915        q==p
  916        p==p_next
  917        excise cell(q,l)
  918        dispose(q)
  919      %finishelse p==p_next
  920    %repeat
  921  %end
  922  
  923  %routine collect recipients(%record(line80listf)%name u)
  924  %integer flag,source
  925  %string(63) v
  926  %record(line80f)%name p
  927  
  928    %on %event 9 %start
  929      p_next==nil; p_prev==nil
  930      p_line=""
  931      append cell(p,u)
  932      -> continue
  933    %finish
  934  
  935    clear frame
  936    source=0
  937    v=var(stage).".imp"
  938    open output(3,v)
  939    select output(3)
  940    p==u_head
  941    %while p##nil %cycle
  942      print string(p_line) %and newline %if "*"#p_line#""
  943      p==p_next
  944    %repeat
  945    print string(snl."*".snl)
  946    close output
  947    select input(0); select output(0)
  948    delete list(u)
  949    xedit(v)
  950    open input(3,v); select input(3)
  951    flag=yes
  952    source=3
  953    read lines(u)
  954  !  The program is stopped if .end is read.
  955  continue:
  956    close input %and destroy(v) %if instream#0
  957    select input(0); select output(0)
  958    prompt("")
  959    separate ids(u)
  960    expand id files(u)
  961  %end
? 961  SOURCE underused %end
? 961  FLAG underused  %end
  962  
  963  %routine set value(%integer item,%string(63) val)
  964  %record(line80f)%name p
  965    data(item)_name=var(item)
  966    delete list(data(item)_val)
  967    p==newline80
  968    p_line=val
  969    append cell(p,data(item)_val)
  970  %end
  971  
  972  %routine set values(%integer item,%record(line80listf)%name vals)
  973    delete list(data(item)_val)
  974    copy lines(vals,data(item)_val)
  975  %end
  976  
  977  %routine pack values(%record(line80listf)%name l)
  978  %string(63) s,t,u
  979  %record(line80f)%name p,q
  980  %record(line80listf) m
  981    %return %if l==nil %or l_head==nil
  982    m_head==nil; m_tail==nil
  983    p==l_head
  984    s=""
  985    %while p##nil %cycle
  986      u=p_line
  987      %while u#"" %cycle
  988        t=u %and u="" %unless u->t.(";").u
  989        %if length(t)+length(s)+3>60 %thenstart
  990          q==newline80
  991          q_line=s
  992          append cell(q,m)
  993          s=""
  994        %finish
  995        %if s="" %then s=t %else s=s."; ".t
  996      %repeat
  997      p==p_next
  998    %repeat
  999    %if s#"" %thenstart
 1000      q==newline80
 1001      q_line=s
 1002      append cell(q,m)
 1003    %finish
 1004    set values(stage,m)
 1005  %end
 1006  
 1007  %routine set vals(%integer flags)
 1008  %record(addresseef)%name q
 1009    %if addresseeno=0 %thenstart
 1010      set value(7,"No addressees")
 1011      set value(8,"")
 1012      set value(9,"")
 1013      set value(10,"")
 1014      set value(14,defaultyours)
 1015    %finishelsestart
 1016      %if addresseeno=1 %then set value(7,"One addressee") %c
 1017+     %else set value(7,itod(addresseeno)." addressees")
 1018      q==addressees_head
 1019      set value(8,q_name) %if flags&nameflag#0 %and q##nil
 1020      %if flags&addressflag#0 %thenstart
 1021        %if q##nil %and q_b_officeaddr_head##nil %c
 1022+       %then set value(9,q_b_officeaddr_head_line) %else set value(9,"")
 1023      %finish
 1024      set value(10,addressees_head_dear) %if flags&dearflag#0 %and q##nil
 1025      set value(14,addressees_head_yours) %if flags&yoursflag#0 %and q##nil
 1026    %finish
 1027  %end
 1028  
 1029  %routine reedit
 1030  %integer n
 1031  %record(addresseef)%name q
 1032  %string(255) u,v,w
 1033  %switch case(0:31)
 1034  
 1035    %on %event 3,9,15 %start
 1036      trace("In Reedit:  Event ".itod(event_event).",".itod(event_sub). %c
 1037+     "  ".Event_message)
 1038      message("Stopped while changing ".var(stage),"stop")
 1039    %finish
 1040  
 1041    stage=0
 1042    set mode(underline)
 1043    %cycle
 1044      set up menu(data,menu1)
 1045      select input(0); select output(0)
 1046      write menu
 1047      stage=cursor depth
 1048      ->case(stage)
 1049  
 1050  case(1):
 1051  !  Read name of file containing heading.
 1052      n=1
 1053      write instruction( %c
 1054+     "Type the name of a file containing the heading of the letters.")
 1055      collect(letterhead)
 1056  {!  If Vax.}
 1057  {    letterhead="U0:[Office]department.lay" %if letterhead=""}
 1058  !
 1059  !  If APM.
 1060      letterhead="office:department" %if letterhead=""
 1061  !
 1062      letterhead=fix file(letterhead,defaultdir,defaultext)
 1063      %if letterhead#"" %and %not exists(letterhead) %thenstart
 1064        set value(stage,letterhead." does not exist or no access.")
 1065        %continue
 1066      %finishelse set value(stage,letterhead)
 1067      %continue %if letterhead=""
 1068  !  Read heading.
 1069      open input(3,letterhead)
 1070      select input(3)
 1071      input lines(heading,n)
 1072      close input %if instream#0
 1073      select input(0)
 1074      select output(0)
 1075      %continue
 1076  case(2):
 1077  !  Telex.
 1078      collect(telex)
 1079      set value(stage,telex)
 1080      %continue
 1081  case(3):
 1082  !  Telephone number.
 1083      collect(telephonenumber)
 1084      set value(stage,telephone number)
 1085      %if telephone number="" %then ext="" %and set value(4,ext)
 1086      %continue
 1087  case(4):
 1088  !  Extension.
 1089      collect(ext) %unless telephone number=""
 1090      set value(stage,ext)
 1091      %continue
 1092  case(5):
 1093  !  Email address.
 1094      collect(email)
 1095      set value(stage,email)
 1096      %continue
 1097  case(6):
 1098  ! My reference.
 1099      collect(myrefce)
 1100      set value(stage,myrefce)
 1101      %continue
 1102  case(7):
 1103  !  Addressees.
 1104      stage=7
 1105      write instruction( %c
 1106+     "Please edit the details of addressees into the file provided.")
 1107  !  Create file of addressees for editing.
 1108      u=var(stage)
 1109      u=v.w %while u->v.("_").w %or u->v.(" ").w
 1110  {!  If Vax.}
 1111  {    u=u.".imp"}
 1112  !
 1113      open output(3,u); select output(3)
 1114      q==addressees_head
 1115      %while q##nil %cycle
 1116        print string(snl.q_name.snl)
 1117        print lines(q_b_officeaddr)
 1118        print string("*".snl)
 1119        %if q_dear#"" %then print string(q_dear.snl) %else print string("*".snl)
 1120        %if q_yours#"" %then print string(q_yours.snl) %c
 1121+       %else print string("*".snl)
 1122        q==q_next
 1123      %repeat
 1124      print string(snl."*".snl)
 1125      close output
 1126      delete list(addressees)
 1127      select input(0); select output(0)
 1128  !  Edit the file of addressees.
 1129      xedit(u)
 1130  !  Read addressees from edited file.
 1131      open input(3,u); select input(3)
 1132      get addressees
 1133      close input %if instream#0
 1134      select input(0)
 1135      flag7=yes
 1136      set vals(addressflag!dearflag!nameflag!yoursflag)
 1137      stage=7
 1138      destroy(u)
 1139      %continue
 1140  case(8):
 1141  !  Name.
 1142      %if addresseeno=0 %then q==newrecipient %else %c
 1143+     %if addresseeno=1 %then q==addressees_head %and excise cell(q,addressees) %c
 1144+     %else screen message("Edit the file of addressees.","") %and ->case(7)
 1145      collect(q_name)
 1146      append cell(q,addressees)
 1147      addresseeno=1
 1148      set vals(nameflag)
 1149      %continue
 1150  case(9):
 1151  !  Address.
 1152      %if addresseeno=0 %then q==newrecipient %else %c
 1153+     %if addresseeno=1 %then q==addressees_head %and excise cell(q,addressees) %c
 1154+     %else screen message("Edit the file of addressees.","") %and ->case(7)
 1155      read screen lines(q_b_officeaddr)
 1156      trim address(q_b_officeaddr)
 1157      append cell(q,addressees)
 1158      addresseeno=1
 1159      set vals(addressflag)
 1160      %continue
 1161  case(10):
 1162  !  Dear.
 1163      %if addresseeno=0 %then q==newrecipient %and addresseeno=1 %else %c
 1164+     %if addresseeno=1 %then q==addressees_head %and excise cell(q,addressees) %c
 1165+     %else screen message("Edit the file of addressees.","") %and ->case(7)
 1166      collect(q_dear)
 1167      append cell(q,addressees)
 1168      addresseeno=1
 1169      set vals(dearflag)
 1170      %continue
 1171  case(11):
 1172  !  Your reference.
 1173      %if addresseeno#1 %thenstart
 1174        set value(stage,"Not unless exactly one adddressee has been defined.")
 1175        %continue
 1176      %finish
 1177      q==addressees_head
 1178      collect(q_yourrefce)
 1179      set value(stage,q_yourrefce)
 1180      %continue
 1181  case(12):
 1182  !  Editor.
 1183      collect(edt)
 1184      lower(edt)
 1185      edt="ie" %if edt=""
 1186      set value(stage,edt)
 1187      %continue
 1188  case(13):
 1189  !  Outname.
 1190      write instruction( %c
 1191+     "Give the name of a file to contain the body of the letter.")
 1192      collect(outname) %until outname#""
 1193      set value(stage,outname)
 1194      xedit(outname)
 1195      %continue
 1196  case(14):
 1197  !  Yours.
 1198      %if addresseeno=0 %then q==newrecipient %and addresseeno=1 %else %c
 1199+     %if addresseeno=1 %then q==addressees_head %and excise cell(q,addressees) %c
 1200+     %else screen message("edit the file of addressees.","") %and ->case(7)
 1201      collect(q_yours)
 1202      append cell(q,addressees)
 1203      addresseeno=1
 1204      set vals(yoursflag)
 1205      %continue
 1206  case(15):
 1207  !  Sent by.
 1208      write instruction( %c
 1209+     "Edit the file that will contain the current information about the sender.")
 1210      collect lines(sentby)
 1211      set values(stage,sentby)
 1212      flag15=yes
 1213      %continue
 1214  case(16):
 1215  !  Cc:.
 1216      write instruction( %c
 1217+     "Edit the file containing the current Cc: list.")
 1218      collect recipients(cc)
 1219      pack values(cc)
 1220      flag16=yes
 1221      %continue
 1222  case(17):
 1223  !  Bcc:.
 1224      write instruction( %c
 1225+     "Edit the file containing the current Bcc: list.")
 1226      collect recipients(bcc)
 1227      pack values(bcc)
 1228      flag17=yes
 1229      %continue
 1230  case(18):
 1231  !  Enclosures.
 1232      collect(enc)
 1233      set value(stage,enc)
 1234      %continue
 1235  case(19):
 1236  !  File copy.
 1237      collect(u)
 1238      lower(u)
 1239      u="y" %if u=""
 1240      %if charno(u,1)=yes %then flcpy="y" %else flcpy="n"
 1241      set value(stage,flcpy)
 1242      %continue
 1243  case(20):
 1244  !  Tolaser.
 1245      u=tostring(tolaser)
 1246      collect(u)
 1247      lower(u)
 1248      %if u="" %then tolaser=0 %else tolaser=charno(u,1)
 1249      set value(stage,tostring(tolaser))
 1250      %continue
 1251  case(21):
 1252  !  Createlabels.
 1253      collect(u)
 1254      lower(u)
 1255      %if u="" %then create labels=0 %else create labels=charno(u,1)
 1256      set value(stage,tostring(create labels))
 1257      %if create labels=no#labels to laser %thenstart
 1258        stage=22
 1259        labels to laser=no
 1260        set value(stage,to string(labels to laser))
 1261      %finish
 1262      %continue
 1263  case(22):
 1264  !  Labelstolaser.
 1265      collect(u)
 1266      lower(u)
 1267      %if u="" %then labels to laser=0 %else labels to laser=charno(u,1)
 1268      set value(stage,tostring(labels to laser))
 1269      %if labels to laser=yes#create labels %thenstart
 1270        stage=21
 1271        create labels=yes
 1272        set value(stage,tostring(create labels))
 1273      %finish
 1274      %continue
 1275  case(23):
 1276  !  Printer.
 1277      collect(printer)
 1278      set value(stage,printer)
 1279      %continue
 1280  case(24):
 1281  !  Directory.
 1282      collect(defaultdir)
 1283      set value(stage,defaultdir)
 1284      %continue
 1285  case(25):
 1286  ! Fax.
 1287      collect(fax)
 1288      set value(stage,fax)
 1289      %continue
 1290  case(26):
 1291  case(27):
 1292  case(28):
 1293  case(29):
 1294  case(30):
 1295      message("Stage has been set to the illegitimate value ".itod(stage),"mon")
 1296  case(0):
 1297      %if letterhead="" %then set value(0,"Set letterhead.") %else %c
 1298+     %if addressees_head==nil %then set value(0,"Provide addessees.") %else %c
 1299+     %if outname="" %then set value(0,"Provide file for letter.") %c
 1300+     %elsestart
 1301  !  If APM.
 1302        lolight(1)
 1303  !
 1304        %exit
 1305      %finish
 1306      %continue
 1307  case(31):
 1308  !  Abandon.
 1309      select input(0); select output(0)
 1310  !  If APM.
 1311      lolight(1)
 1312  !
 1313      stop screen mode
 1314      message("Letters abandoned.","stop")
 1315    %repeat
 1316  %end
 1317  
 1318  %routine initial settings
 1319  %integer i,n
 1320  %string(255) u
 1321  %record(line80f)%name p,q
 1322    start screen mode
 1323  !  Addresseeno, addressees, nilllist, val, yesnostart.
 1324    addresseeno=0; addressees_head==nil; addressees_tail==nil
 1325    nillist_head==nil; nillist_tail==nil
 1326    %for i=0,1,31 %cycle
 1327      data(i)_name=var(i)
 1328      data(i)_val_head==nil
 1329      data(i)_val_tail==nil
 1330    %repeat
 1331    helpfile="letterhelp.imp"
 1332    yesnostar_head==nil; yesnostar_tail==nil
 1333    p==newline80; p_line="yes"; append cell(p,yesnostar)
 1334    p==newline80; p_line="no"; append cell(p,yesnostar)
 1335    p==newline80; p_line="*"; append cell(p,yesnostar)
 1336    p==newline80; p_line=end; append cell(p,yesnostar)
 1337  !  Bcc:.
 1338    stage=17
 1339    bcc_head==nil; bcc_tail==nil
 1340    q==newline80; q_line="*"
 1341    set up(q_line,lett.var(stage), var(stage),"",nillist)
 1342    set value(stage,q_line)
 1343    append cell(q,bcc)
 1344  !  Cc:.
 1345    stage=16
 1346    cc_head==nil; cc_tail==nil
 1347    q==newline80; q_line="*"
 1348    set up(q_line,lett.var(stage),var(stage),"",nillist)
 1349    set value(stage,q_line)
 1350    append cell(q,cc)
 1351  !  Createlabels.
 1352    stage=21
 1353    set up(u,lett.var(stage),var(stage),yesnomess,yesnostar)
 1354    lower(u)
 1355    %if u="" %then create labels=0 %else create labels=charno(u,1)
 1356    set value(stage,tostring(create labels))
 1357    %if create labels=no %thenstart
 1358      labels to laser=no
 1359      stage=22
 1360      set value(stage,"no")
 1361    %finish
 1362  !  Dear.
 1363    stage=10
 1364    set up(defaultdear,lett.var(stage),var(stage),"",nillist)
 1365    defaultdear="*" %if defaultdear=""
 1366    set value(stage,defaultdear)
 1367  !  Directory.
 1368    stage=24
 1369    set up(defaultdir,lett.var(stage),var(stage),"",nillist)
 1370    set value(stage,defaultdir)
 1371  !  Editor.
 1372    editors_head==nil; editors_tail==nil
 1373    p==newline80; p_line="vecce"; append cell(p,editors)
 1374    p==newline80; p_line="ie"; append cell(p,editors)
 1375    stage=12
 1376    set up(edt,lett.var(stage),var(stage),edmess,editors)
 1377    edt="ie" %if edt=""
 1378    set value(stage,edt)
 1379  !  Email address.
 1380    stage=5
 1381    set up(email,lett.var(stage),var(stage),"",nillist)
 1382    set value(stage,email)
 1383  !  Enclosures.
 1384    stage=18
 1385    set up(enc,lett.var(stage),var(stage),"",nillist)
 1386    set value(stage,enc)
 1387  !  Extension.
 1388    stage=4
 1389    set up(ext,lett.var(stage),var(stage),"",nillist) %unless telephonenumber=""
 1390    set value(stage,ext)
 1391    flag7=no; flag15=no; flag16=no; flag17=no
 1392    stage=19
 1393  !  Fax. Facsimile.
 1394    stage=25
 1395    set up(fax,lett.var(stage),var(stage),"",nillist)
 1396    set value(stage,fax)
 1397  !  File copy.
 1398    stage=19
 1399    set up(flcpy,lett.var(stage),var(stage),"",nillist)
 1400    flcpy="y" %if flcpy=""
 1401    %if flcpy="" %then flcpy="n" %else %c
 1402+   %if charno(flcpy,1)='y' %then flcpy="y" %else flcpy="n"
 1403    set value(stage,flcpy)
 1404  !  Read name of file containing heading.
 1405    heading_head==nil; heading_tail==nil
 1406    stage=1
 1407    set up(letterhead,lett.var(stage),var(stage),"",nillist)
 1408    letterhead=fix file(letterhead,defaultdir,defaultext)
 1409    %if letterhead="" %then set value(stage,"not defined.") %else %c
 1410+   %if exists(letterhead) %thenstart
 1411      set value(stage,letterhead)
 1412  !  Read heading.
 1413      n=40
 1414      open input(3,letterhead)
 1415      select input(3)
 1416      input lines(heading,n)
 1417      close input %if instream#0
 1418    %finishelse set value(stage,letterhead."  does not exist or no access.")
 1419    select input(0)
 1420    select output(0)
 1421  !  Labellist.
 1422    labellist_head==nil; labellist_tail==nil
 1423  !  Labelstolaser.
 1424    stage=22
 1425    set up(u,lett.var(stage),var(stage),yesnomess,yesnostar)
 1426    lower(u)
 1427    labels to laser=0
 1428    labels to laser=charno(u,1) %if length(u)>0
 1429    set value(stage,tostring(labels to laser))
 1430    %if labels to laser=yes %thenstart
 1431      stage=21
 1432      create labels=yes
 1433      set value(stage,tostring(create labels))
 1434    %finish
 1435    linewidth=labelwidth-2*leftmargin
 1436  !  Menu.
 1437    menu1(i)=i %for i=0,1,25
 1438    menu1(26)=31
 1439    menu1(27)=-1
 1440  !  My reference.
 1441    stage=6
 1442    set up(myrefce,lett.var(stage),var(stage),"",nillist)
 1443    set value(stage,myrefce)
 1444  !  Outname.
 1445    stage=13
 1446    outname=""
 1447    set value(stage,outname)
 1448    printdepth=labeldepth-2*topmargin
 1449  !  Printer.
 1450    printerlist_head==nil; printerlist_tail==nil
 1451    p==newline80; p_line="lp2"; append cell(p,printerlist)
 1452    p==newline80; p_line="lp3"; append cell(p,printerlist)
 1453    p==newline80; p_line=end; append cell(p,printerlist)
 1454    stage=23
 1455    set up(printer,lett.var(stage),var(stage),printmess,printerlist)
 1456    printer="lp2" %if printer=""
 1457    set value(stage,printer)
 1458  !  Sent by.
 1459    sent by_head==nil; sent by_tail==nil
 1460    stage=15
 1461    i=1
 1462    %cycle
 1463      p==newline80
 1464      set up(p_line,"letters_sent_by".itod(i),var(stage),"",nillist)
 1465      u=p_line; lower(u)
 1466      screen message("Stopped while changing Sent by.","stop") %if u=end
 1467      %exit %if u="*" %or u=""
 1468      append cell(p,sent by)
 1469      i=i+1
 1470    %repeat
 1471    set values(stage,sent by)
 1472    stage=0
 1473    star_head==nil; star_tail==nil
 1474    p==newline80; p_line="*"; append cell (p,star)
 1475  !  Start video.
 1476    select input(0); select output(0)
 1477  !  Telex
 1478    stage=2
 1479    set up(telex,lett.var(stage),var(stage),"",nillist)
 1480    set value(stage,telex)
 1481  !  Telephone number.
 1482    stage=3
 1483    set up(telephonenumber,lett.var(stage),var(stage),"",nillist)
 1484    set value(stage,telephone number)
 1485  !  Tolaser.
 1486    stage=20
 1487    set up(u,lett.var(stage),var(stage),yesnomess,yesnostar)
 1488    lower(u)
 1489    %if u="" %then to laser=0 %else to laser=charno(u,1)
 1490    set value(stage,tostring(to laser))
 1491  !  Yours.
 1492    stage=14
 1493    set up(defaultyours,lett.var(stage),var(stage),"",nillist)
 1494    set value(stage,defaultyours)
 1495  %end
 1496  
 1497  !  If APM.
 1498  %routine send to printer(%string(255) file)
 1499  ! Generate the file containing commands for EFTP
 1500    openoutput(3,"$.com")
 1501    selectoutput(3)
 1502    printline("t ".file."/b::lp2:")
 1503    printline("e")
 1504    closeoutput
 1505  ! Invoke EFTP
 1506    openinput(0,"$.com")
 1507    obeycommand("eftp","")
 1508   ! Reset stream 0 to be the terminal again
 1509    openinput(0,":t")
 1510    selectinput(0)
 1511    prompt("")
 1512    destroy(file)
 1513    destroy("$.com")
 1514  %end
 1515  !
 1516  
 1517  { Main Program}
 1518  
 1519  !  Seqno uses input and output streams 1.
 1520  
 1521    %on %event 15 %start
 1522      message(""".end"" or ""@"" read.","stop")
 1523    %finish
 1524  
 1525    select input(0); select output(0)
 1526    initial settings
 1527    reedit
 1528    labels=""; letters=""
 1529    letters="x".seqno.".lay"
 1530    labels="x".seqno.".lay" 
 1531    message("No addressees.","stop") %if addressees_head==nil
 1532    stop screen mode
 1533    print letters(addressees,cc,bcc)
 1534  !  Delay for output to appear on the screen.
 1535    j=0
 1536    %for i=0,1,100000 %cycle
 1537      j=j+1
 1538    %repeat
 1539  {!  If Vax.}
 1540  {  command="comm".seqno.".com"}
 1541  {  open output(3,command)}
 1542  {  select output(3)}
 1543  {  %if tolaser=yes %thenstart}
 1544  {  !  The extra snl gives a blank password.}
 1545  {    print line("print/q=print$".printer.ssp.letters)}
 1546  {    print line("$if $status.eq.1 then delete ".letters.";*")}
 1547  {  %finish}
 1548  {  %if labelstolaser=yes %thenstart}
 1549  {  !  The extra snl gives a blank password.}
 1550  {    print line("print/q=print$".printer.ssp.labels.snl)}
 1551  {    print line("$if $status.eq.1 then delete ".labels.";*")}
 1552  {  %finish}
 1553  {  print line("$delete sentby.*;*") %if flag15=yes}
 1554  {  print line("$delete addressees.imp;*") %if flag7=yes}
 1555  {  print line("$delete cc.imp;*") %if flag16=yes}
 1556  {  print line("$delete bcc.imp;*") %if flag17=yes}
 1557  {  print line("$delete ".command.";*")}
 1558  {  close output}
 1559  {  select output(0)}
 1560  {  u="@".command}
 1561  {  d_a=addr(u)+1; d_l=length(u)}
 1562  {  flag=0}
 1563  {  flag=spawn(d)}
 1564  {  message("Flag from ".u."=".itoh(flag),"") %if flag&1=0}
 1565  !
 1566  !  If APM.
 1567    send to printer(letters) %and %c
 1568+   message("Letters sent to laser printer.","") %if tolaser=yes
 1569    send to printer(labels) %and %c
 1570+   message("Labels sent to laser printer.","") %if labelstolaser=yes
 1571  !
 1572  %endofprogram
?1572  U underused     %endofprogram
?1572  PRINTDEPTH underused %endofprogram
?1572  LINEWIDTH underused %endofprogram
?1572  FLAG17 underused %endofprogram
?1572  FLAG16 underused %endofprogram
?1572  FLAG15 underused %endofprogram
?1572  FLAG7 underused %endofprogram
?1572  FLAG underused  %endofprogram
?1572  DEFAULTHEAD underused %endofprogram
?1572  HDXTOI unused   %endofprogram
?1572  CURRENTUSER unused %endofprogram
?1572  CURRENTFS unused %endofprogram
?1572  MATCHES unused  %endofprogram
?1572  WILDNESS unused %endofprogram
?1572  ETHERSTATION unused %endofprogram
?1572  ETHC underused  %endofprogram
?1572  ETHD underused  %endofprogram
?1572  RSAP unused     %endofprogram
?1572  LSAP unused     %endofprogram
?1572  LDTE unused     %endofprogram
?1572  NAK unused      %endofprogram
?1572  STX unused      %endofprogram
?1572  DTX unused      %endofprogram
?1572  ERR unused      %endofprogram
?1572  FSPORT unused   %endofprogram
?1572  CYLOCK unused   %endofprogram
?1572  ETHERREAD unused %endofprogram
?1572  USERNO unused   %endofprogram
?1572  IEVERSION underused %endofprogram
?1572  SYSDICT unused  %endofprogram
?1572  EXTDICT unused  %endofprogram
?1572  MULDIV unused   %endofprogram
LATEST compiled: 1707 statements (+ 316 comments) to 26802 bytes (+ 826)
