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 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)