#-h- lssym            279 asc 29-oct-80 00:38:09 tools
 define(FCOLWIDTH,18)
 define(SORTBYDEFAULT,NO)
 define(FLMAX,10)
define(HEADER_LINE_1,"filename            protection      last modified     size   owner@n")
define(HEADER_LINE_2,"--------          --------------  ----------------- -------  -----@n@n")
 define(RIGHT_MARGIN,80)
#-h- cls              614 asc 29-oct-80 00:38:09 tools
 common / cls / verbos, dodate, revers, sortit, dirsw,
		dohead, packit, scrat(FILENAMESIZE)

 integer verbos		# verbose switch - init NO; set by -vt
 integer dodate		# dodate switch - init NO ; set by -t
 integer revers		# revers switch - init NO ; set by -r
 integer sortit		# if need to sort entries ; init SORTBYDEFAULT
			# sortit is set to YES if (dodate == YES |
			# revers == YES)
 integer dirsw		# do directory switch - init NO; set by -d
 integer dohead		# print header on verbose listings; init = NO
 integer packit		# pack non-verbose files in 5 columns; init=YES
 character scrat	# scratch file name
#-h- ls.r            4782 asc 29-oct-80 00:38:10 tools
#-h- lsdrv.q           43 asc 29-oct-80 00:30:17 tools
# call initr4
# call ls
# call endr4
# end
#-h- initls.q        1061 asc 29-oct-80 00:35:30 tools
 include lssym

 subroutine initls(arg)

 integer i, getarg, index, tty
 character arg(FILENAMESIZE)

 include cls

 verbos = NO
 dohead = NO
 dodate = NO
 revers = NO
 dirsw = NO
 packit = tty(STDOUT)
 sortit = SORTBYDEFAULT
 for (i=1; getarg(i, arg, FILENAMESIZE) != EOF; i=i+1)
    {
    call fold(arg)
    if (arg(1) == MINUS)
	{
	if (index(arg, LETV) > 0)
	    verbos = YES
	if (index(arg, LETH) > 0)
	    dohead = YES
	if (index(arg, LETT) > 0)
	    dodate = YES
	if (index(arg, LETR) > 0)
	    revers = YES
	if (index(arg, LETN) > 0 & SORTBYDEFAULT == NO)
	    sortit = YES		# sort by name
	if (index(arg, LETD) > 0)
	    dirsw = YES
	if (index(arg, DIG1) > 0)
	    packit = NO
	call delarg(i)
	i = i + 1
	}
    else if (arg(1) == QMARK & arg(2) == EOS)
	call error("usage:  ls [-1dhnrtv] [path]...")
    }
 if (dodate == YES)
    verbos = YES
 if (dodate == YES | revers == YES)
    sortit = YES
 if (verbos == NO)
    dohead = NO
 else
    packit = NO		# packing impossible in verbose mode
 if (sortit == YES)
    call scratf(ls0, scrat)

 return
 end
#-h- endls.q           67 asc 29-oct-80 00:30:18 tools
 subroutine endls

 include cls

 call remove(scrat)

 return
 end
#-h- lss.q           2693 asc 29-oct-80 00:30:19 tools
# subroutine ls
 subroutine main

 integer level, opendr, desc, depth, ptr(MAXDIRECTS), j, getpat, outfil,
	 create, gdrprm, i, length, match, n, open, getlin, getarg,
	 status, nxtcol
 character ppath(FILENAMESIZE), defpat(2), file(FILENAMESIZE),
	   buf(MAXLINE), pat(132), obuf(MAXLINE)

 include cls

 string dirpat "?*/"
 string head1 HEADER_LINE_1
 string head2 HEADER_LINE_2

 data defpat/PERCENT, EOS/

 call initls(file)
 level = 0
 if (dohead == YES)
    {
    call putlin(head1, STDOUT)
    call putlin(head2, STDOUT)
    }
 if (packit == YES)
    call inpack(nxtcol, RIGHT_MARGIN, obuf, STDOUT)
 repeat
    {
    level = level + 1
    status = getarg(level, ppath, FILENAMESIZE)
    if (status == EOF & level > 1)
	break
    else if (status == EOF)
	call gwdir(ppath, PATH)
    call scopy(defpat, 1, file, 1)
    if (opendr(ppath, desc) == ERR)
	{
	call scopy(ppath, 1, buf, 1)
	call mkpath(buf, ppath)
	call exppth(ppath, depth, ptr, buf)
	j = ptr(depth)
	junk = gtftok(ppath, j, file)
	j = ptr(depth)
	ppath(j) = EOS
	if (opendr(ppath, desc) == ERR)
	    call cant(ppath)
	}
    if (dirsw == YES)
	call concat(file, dirpat, file)
    call fold(file)
    if (getpat(file, pat) == ERR)
	call error("Illegal pattern.")
    if (sortit == YES)
	{
	outfil = create(scrat, WRITE)
	if (outfil == ERR)
	    call error("Error creating temporary file.")
	}
    else
	outfil = STDOUT
    while (gdrprm(desc, file) != EOF)
	{
	i = length(file) + 1
	file(i) = NEWLINE
	file(i+1) = EOS
	call fold(file)
	if (match(file, pat) == YES)
	    {
	    i = length(file)
	    file(i) = EOS
	    if (packit == YES & outfil == STDOUT)
		call dopack(file, nxtcol, RIGHT_MARGIN, obuf, STDOUT)
	    else
		{
		if (verbos == YES)
		    {
		    call gdraux(desc, file, buf, ppath)
		    if (dodate == YES)
		        call putlin(ppath, outfil)
		    call putlin(file, outfil)
		    n = FCOLWIDTH - length(file)
		    for (i=1; i <= n; i=i+1)
		        call putch(BLANK, outfil)
		    call putlin(buf, outfil)
		    }
		else
		    call putlin(file, outfil)
		call putch(NEWLINE, outfil)
		}
	    }
	}
    call closdr(desc)
    if (sortit == YES)
	{
	call close(outfil)
	call sortls(scrat, revers, buf)
	outfil = open(scrat, READ)
	if (outfil == ERR)
	    call error("Error in opening sorted scratch file.")
	while (getlin(buf, outfil) != EOF)
	    {
	    if (dodate == YES)
		i = TCOLWIDTH + 1
	    else
		i = 1
	    if (packit == YES)
		{
		i = 1
		junk = getwrd(buf, i, file)
		call dopack(file, nxtcol, RIGHT_MARGIN, obuf, STDOUT)
		}
	    else
		call putlin(buf(i), STDOUT)
	    }
	call close(outfil)
	}
    if (packit == YES)
	call flpack(nxtcol, RIGHT_MARGIN, obuf, STDOUT)
    }
 call endls

 return
 end
#-h- sortls.q         643 asc 29-oct-80 00:30:20 tools
 subroutine sortls(file, revers, buf)

 character file(ARB), descr(PIDSIZE), buf(ARB),
	   proc(FILENAMESIZE), spath(80)
 integer revers, i, spawn, loccom

 string pluso " +o"
 string mr " -r"
 string sort "sort"

 i = 1
 call stcopy(sort, 1, buf, i)
 call chcopy(BLANK, buf, i)
 call stcopy(file, 1, buf, i)
 call stcopy(pluso, 1, buf, i)
 call stcopy(file, 1, buf, i)
 if (revers == YES)
    call stcopy(mr, 1, buf, i)
 buf(i) = EOS
 call impath(spath)
 if (loccom(sort, spath, proc) != BINARY)
    call error("Cannot locate sort image file.")
 if (spawn(proc, buf, descr, WAIT) == ERR)
    call error("error in spawning sort")
 return
 end