%%s 3/3/428
%%d D 1.2 30-Jul-83 08:46:54 tools 2 1
%%c Removed trailing periods from quoted strings.
%%s 0/0/0
%%d D 1.1 27-Mar-82 14:59:18 v1.1 1 0
%%c Version 1.1 is the Spring 1982 Distribution of the LBL/Hughes release
%%c of the Software Tools Virtual Operating System software and documentation.
%%T
%%I 1
#-h- flist            244  asc  25-mar-82 09:35:58  v1.1 (sw-tools v1.1)
 ## flist common block
 #  Put on a file called 'flist'
 # Used by the tools:  sort, roff, lpr (VMS version), ls (VMS version)
 
 #flist - common block
 
  common /flist/  flevel, ffiles(FILENAMESIZE, FLMAX)
  integer flevel
  character ffiles
#-h- lprcom           504  asc  25-mar-82 09:35:58  v1.1 (sw-tools v1.1)
#----------------------------------------------------------------------
##      lprcom -- common block for lpr with switch info

        common / lprcom / queue, verbos, ncopies

        integer queue   # integer indicating ias queue
                        # 0 for wide paper
                        # 1 for narrow paper
                        # 6 for sticky labels
        integer verbos  # print notification of successful queuing on ERROUT
        integer ncopies # number of copies to make of file
#-h- lprsym           251  asc  25-mar-82 09:35:59  v1.1 (sw-tools v1.1)
   define(OVERPRINTCHAR,PLUS)
   define(CONTROLL,12)
   define(UPPAGECHAR,DIG1)
   define(NEWPAGECHAR,DIG1)
   define(LINEFEED,BLANK)
   define(PAGELENGTH,62)
   define(FLMAX,10)
   define(NARROWQUEUE,1)
   define(WIDEQUEUE,0)
   define(LABELQUEUE,6)
%%D 2
#-h- lpr.r          10056  asc  25-mar-82 09:36:01  v1.1 (sw-tools v1.1)
%%E 2
%%I 2
#-h- lpr.r          10060  asc  30-jul-83 08:46:28  tools (lblh csam sventek)
%%E 2
#-h- main            3270  asc  25-mar-82 09:35:39  v1.1 (sw-tools v1.1)
#---------------------------------------------------------------------------
##      lpr -- main subroutine for formatting file for line printer

        include lprsym

#---------------------------------------------------------------------------

        DRIVER(lpr)

        integer equal, prsw, getarg, i, assign, binary, outf, int, open,
                values(2), access, junk, filnfo
        integer remove, note
        character oname(FILENAMESIZE), iarg(FILENAMESIZE), lprf(4),
                  filenm(FILENAMESIZE)

        include flist
        include lprcom

        string term "SYS$OUTPUT"
	string first "Cannot open file named `"
	string last  "'@n"

        data lprf/'l', 'p', 'r', EOS/

        call query("usage:  lpr [-n][-l][-v][-c<num of copies>] [file] ...")
        ncopies = 1
        flevel = 0
        queue = WIDEQUEUE
        verbos = NO
        for (i=1; getarg(i, iarg, FILENAMESIZE) != EOF; i=i+1)
            {
            if (iarg(1) == '+' | iarg(1) == '-')
                call lprcmd(iarg)
            else
                call fstack(iarg)
            }
        call lprdef(queue, oname)
        junk = filnfo(STDOUT, filenm, access)   # get name and access of
                                                # STDOUT
        if (equal(term, filenm) == YES)
            prsw = YES
        else
            {
            prsw = NO
            call scopy(filenm, 1, oname, 1)
            call close(STDOUT)
            junk = remove(oname)
            }
        if (assign(oname, STDOUT, PRINT) == ERR)
            call cant(oname)
        call lprint
        if (ncopies == 1)
            outf = STDOUT
        else
            {
            call scratf(lprf, iarg)
            int = open(iarg, WRITE)
            if (int == ERR)
                call error("error opening scratch file")
            outf = int
            }
    if (prsw == YES & flevel > 1)       # list of filenames
        {
        call putch(UPPAGECHAR, outf)
        for (i=1; i<=PAGELENGTH/2-flevel-5; i=i+1)
            call putch('@n', outf)
        for (i=1; i<=flevel; i=i+1)
            call lprttl(ffiles(1,i), outf)
        call putch(NEWPAGECHAR, outf)
        call putch('@n', outf)
        }

        if (flevel > 0)
            for (i=1; i<=flevel; i=i+1)
                {
                if (assign(ffiles(1,i), STDIN, READ) == ERR)
		    {
		    call putlin(first, ERROUT)
		    call putlin(ffiles(1,i), ERROUT)
                    call putlin(last, ERROUT)
		    }
                else
                    {
                    call refrmt(ffiles(1,i), STDIN, outf, binary)
                    call close(STDIN)
                    }
                }
    
        else
            call refrmt("stdin", STDIN, outf, binary)
        call close(outf)
        if (ncopies > 1)
            {
            call close(int)
            int = open(iarg, READ)
            junk = note(values, int)
            for (i=1; i <= ncopies; i=i+1)
                {
                call seek(values, int)
                call fcopy(int, STDOUT)
                }
            call close(int)
            junk = remove(iarg)
            call close(STDOUT)
            }
        if (prsw == YES)
            call dispoz(oname, queue)

        DRETURN
        end
%%D 2
#-h- dispoz          2031  asc  25-mar-82 09:35:41  v1.1 (sw-tools v1.1)
%%E 2
%%I 2
#-h- dispoz          2030  asc  30-jul-83 08:44:45  tools (lblh csam sventek)
%%E 2
 subroutine dispoz(file, forms)

 character file(FILENAMESIZE), mybox(FILENAMESIZE), buf(MAXLINE)
 integer forms, desc(2), chan, crembx, int, status, sys$sndsmb,
         open, getlin, length, jbcsts, n, i, itoc, index
 integer*2 unit, msgtyp, jobid
 logical*1 x(74)
 common / smbmsg / reques, qname(16), devnam(16), fileid(6),
                   dirnam(6), filnam(20),
                   brst, copy, ncopy, dele, flag, form,
                   frmtyp, trmn8r

 integer*2 reques
 logical*1 qname, devnam, fileid, dirnam, filnam, brst, copy, ncopy, dele,
           flag, form, frmtyp, trmn8r
 equivalence (x(1),reques)
 equivalence (buf(1),msgtyp),(buf(3),jobid),(jbcsts,buf(5))
 external myopen

 include lprcom
 include flist

 data qname/9,'S','Y','S','$','P','R','I','N','T',6*EOS/
 data filnam/19,19*'x'/
 data brst, copy, dele, flag, form, trmn8r/2, 10, 1, 4, 36, 0/
 data reques/8/
 data ncopy, frmtyp/1, 0/

 desc(1) = 74
 desc(2) = %loc(x)
 call myopen(file, x)
 if (flevel > 0)
    call mklocl(ffiles(1,1), buf)
 else
    call strcpy("standard.in", buf)
 i = index(buf, ']') + 1
 filnam(1) = length(buf(i))
 call scopy(buf, i, filnam, 2)
 call upper(filnam(2))
 n = length(buf(i)) + 2
 for (i=n; i <= 20; i=i+1)
    filnam(i) = ' '
 frmtyp = forms
 call scopy("SMB", 1, mybox, 1)
 status = crembx(mybox, YES, chan, unit)
 if (status == OK)
    {
    int = open(mybox, READ)
    status = sys$sndsmb(desc, %val(chan))
    if (.not.status)
%%D 2
        call remark("Error in queuing file to printer.")
%%E 2
%%I 2
        call remark("Error in queuing file to printer")
%%E 2
    else
        {
        n = getlin(buf, int)
        if (jbcsts & verbos == YES)
            {
            n = jobid
            call putlin("Job", ERROUT)
            i = itoc(n, buf, MAXLINE)
            call putlin(buf, ERROUT)
            call remark(" queued to sys$print")
            }
        else if (.not. jbcsts)
            {
            n = jbcsts
            call puthex(n, buf)
            call putlin("Error in job: status = ", ERROUT)
            call remark(buf)
            }
        }
    }
 return
 end
#-h- fstack           358  asc  25-mar-82 09:35:43  v1.1 (sw-tools v1.1)
   #------------------------------------------------------------
   ## fstack - generate stack of input files

   subroutine fstack (iarg)

   integer i
   character iarg(FILENAMESIZE)

   include flist

   if (flevel < FLMAX)
     {
     flevel = flevel + 1
     for (i=1; i<=FILENAMESIZE; i=i+1)
         ffiles(i,flevel) = iarg(i)
     }
   return
   end
#-h- lprcmd           784  asc  25-mar-82 09:35:44  v1.1 (sw-tools v1.1)
#---------------------------------------------------------------
##      lprcmd -- interpret lpr switches

        subroutine lprcmd(iarg)

        character iarg(FILENAMESIZE), clower
        integer i, ctoi

        include lprcom

        if (iarg(1) == '-' & clower(iarg(2)) == 'n')
            queue = NARROWQUEUE
        else if (iarg(1) == '-' & clower(iarg(2)) == 'l')
            queue = LABELQUEUE
        else if (iarg(1) == '-' & clower(iarg(2)) == 'v')
            verbos = YES
        else if (iarg(1) == '-' & clower(iarg(2)) == 'c')
            {
            i = 3
            ncopies = ctoi(iarg, i)
            if (ncopies <= 0)
                ncopies = 1
            }
        else
            call remark("Ignoring invalid argument!")

        return
        end
#-h- lprdef           286  asc  25-mar-82 09:35:45  v1.1 (sw-tools v1.1)
 subroutine lprdef(queue, file)

 character file(FILENAMESIZE)
 integer queue, itoc, i, junk, index

 string lprscr "lprscr."

 call getdir(LPRDIRECTORY, LOCAL, file)
 i = length(file) + 1
 call stcopy(lprscr, 1, file, i)
 junk = itoc(queue, file(i), 3)
 call upper(file)

 return
 end
#-h- lprint           196  asc  25-mar-82 09:35:46  v1.1 (sw-tools v1.1)
#--------------------------------------------------------------
##      lprint -- initialize lpr output file
##      for IAS, this is a stub

        subroutine lprint

        return
        end
#-h- lprttl           433  asc  25-mar-82 09:35:47  v1.1 (sw-tools v1.1)
#--------------------------------------------------------------
##      lprttl -- subroutine to print out filenames on
##                lpr title page

        subroutine lprttl(buf, out)

        character buf(FILENAMESIZE)
        integer i, out

        for (i=1; i<=30; i=i+1)
            call putch(' ', out)
        call putlin(buf, out)
        call putch('@n', out)
        call putch('@n', out)

        return
        end
#-h- osk             1809  asc  25-mar-82 09:35:49  v1.1 (sw-tools v1.1)
 ## osk - convert backspaces into multiple lines (lprr).
 
   subroutine osk(infile, outfl)
 
#  integer min
   integer infile, outfl, col, first, i, j, print(2), bcount
   character c, buf(MAXLINE, 2), prevc, getch
 
   col = 1
   first = YES
   for (i=1; i<=2; i=i+1)
       {
       buf(1,i) = OVERPRINTCHAR
       for (j=2; j<=MAXLINE; j=j+1) buf(j, i) = ' '
       print(i) = NO
       }
   prevc = '@n'
   while (getch(c, infile) != EOF)
       {
       if (col == 1)
           if (c == CONTROLL)
               {
               if (first == YES)
                   {
                   call putch(UPPAGECHAR, outfl)
                   first = NO
                   }
               else
                   call putch(NEWPAGECHAR, outfl)
               for (i=1; getch(c, infile) == '@n' & i<=2; i=i+1) ;
               }
           else
               call putch(LINEFEED,outfl)
       if (c == EOF) break
       if (c == BACKSPACE)
           {
           bcount = bcount + 1
           bcount = min(bcount, 2)
           print(bcount) = YES
           }
       else
           {
           if (prevc == BACKSPACE)
               {
               j = min(col, MAXLINE-2)
               buf(j, bcount) = c
               }
           else
               {
               bcount = 0
               call putch(c, outfl)
               col = col + 1
               }
           }
       if (c == '@n')
           {
           for (i=1; i<=2 & print(i) == YES; i=i+1)
               {
               buf(col, i) = '@n'
               buf(col+1, i) = EOS
               call putlin(buf(1,i), outfl)
               for (j=2; j<=MAXLINE; j=j+1) buf(j,i) = ' '
               print(i) = NO
               }
           col = 1
           }
       prevc = c
       }
   call putch('@n', outfl)
   return
   end
#-h- refrmt           232  asc  25-mar-82 09:35:50  v1.1 (sw-tools v1.1)
## refrmt - reformat terminal mode file for line printing (lprr).

subroutine refrmt (buf,infile,outfl,binary)
integer infile,outfl,binary
character buf(FILENAMESIZE)

        binary = NO
        call osk(infile, outfl)

return
end
#-h- lpr.fmt         1180  asc  25-mar-82 09:36:04  v1.1 (sw-tools v1.1)
.so ~bin/manhdr
.hd Lpr (1) 29-Oct-80
queue file to printer
.sy
lpr [-n] [-l] [-v] [-c<num of copies>] [file]...
.ds
lpr takes the named files (or standard input if none are specified) and
queues copies of them to the printer.  All overstriking and underlining
in the documents which have been achieved via backspaces are converted
to the appropriate overstrike lines to drive the printer.  The switches
have the following meaning:
.sp
.in +5
.ti -3
-n narrow paper queue.  These files are queued to the printer with
forms=1.
.ti -3
-l label queue.  These files are queued to the printer with forms=6.
.ti -3
-v verbose.  The job number of the print job will be displayed on the
screen at the successful queueing of the file.
.ti -4
-cn number of copies.  The number of copies of the file to be queued may
be specified this way.  The default is 1 copy.
.sp
.in -5
The default behavior of lpr is to queue the files with forms=0.  In all
cases, the print queue to which the symbiont messages are directed is
sys$print.  If you do not maintain this queue, you will have to modify
the source code for lpr.  The routine to change is lpr.w/lpr.r/dispoz.
.fl
.sa
.di
.au
Joe Sventek
.bu
%%E 1