Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - utilities/dired.original
There are no other files named dired.original in the archive.
COMMENT **CONTENTS**
      Modified 7-21-80 JQJ
      Modified 12-9-79 KO (labeled LOTS)
      Modified 2-12-79 JQJ
      Written 26-APR-76 20:56:03

  2   begin
  3   ! The basic storage format is as follows:
  4   simple boolean procedure archd 
  5   boolean procedure deld
  6   define create = <fdb!block ['13]>,
  7   simple procedure zap!buffer
  8   simple procedure cntl!o!int
  9   simple procedure asc		! switches from binary to ascii mode
 10   simple procedure wait!for!cr (string  prompt)
 11   simple procedure no!dollar!sign
 12   simple string procedure construct!name (integer jfn)
 13   simple string procedure dirsh (integer num)
 14   simple integer procedure get!group
 15   procedure set (integer jfn)	! main setup procedure
 16   simple procedure set!mask 
 17   ! the following two procedures are for formating.  Form fills the
 18   procedure line0
 19   procedure refresh (integer start)
 20   procedure pwindow
 21   procedure mwindow
 22   simple procedure allback
 23   simple procedure allforward
 24   simple procedure prompt (integer i)
 25   simple procedure refer
 26   procedure delet1 (integer i)
 27   procedure delete (integer i)
 28   PROCEDURE delete!all
 29   procedure undel1 (integer i)
 30   procedure undel (integer i)
 31   procedure undel!all
 32   simple procedure archive (integer jfn)
 33   simple procedure reset (integer jfn)
 34   simple procedure arch1 (integer i)
 35   simple procedure arch (integer i)
 36   simple procedure arch!all
 37   simple procedure res1 (integer i)
 38   simple procedure rest (integer i)
 39   simple procedure rest!all
 40   procedure typin (string str)	! simulates a type in str
 41   procedure list (integer which)
 42   procedure tv (integer which)
 43   procedure skip
 44   procedure type (integer i)
 45   simple integer procedure cvchar (integer char)
 46   simple procedure help
 47   simple boolean procedure sizeok (reference integer i, j)
 48   simple boolean procedure writeok (reference integer i, j)
 49   simple boolean procedure alphok (reference integer i, j)
 50   procedure order
 51   procedure change!format
 52   simple procedure dump
 53   simple procedure exec
 54   simple procedure finish
 55   integer jfn, edir
 56   while true do

;
begin "dired"
comment first pick up the sri compile time switch from the terminal;

ifc not declaration (tops20!switch) thenc define tops20!switch = true; endc;
ifc not tops20!switch thenc
require "
If this is the sri version please enter
""define sri!switch = true;""
If this is the imsss version type
""define imsss!switch = true;""
otherwise type ^Z" message;
require "tty:" source!file;
endc;
ifc tops20!switch thenc define sri!switch = true; endc;
ifc not declaration (sri!switch) thenc define sri!switch = false endc;
ifc not declaration (imsss!switch) thenc define imsss!switch = false; endc;
comment above is for sri version;
ifc tops20!switch thenc require "tops20 version " message;
elsec
ifc sri!switch thenc require "SRI version " message;
elsec
ifc imsss!switch thenc require "IMSSS version " message;
elsec
require "no version" message;
endc
endc
endc

external procedure bail;
external procedure ddt;
require "ps:<tvedit>dpy.sai" source!file;

ifc tops20!switch thenc
require "sai:pksort." source!file;
elsec
ifc imsss!switch thenc
require "<pentti>sort" source!file;
elsec
require "<sail>pksort." source!file;
endc
endc

require "<><>" delimiters;
define ! = <comment>;

! The following magic code thanks to Bob Smith;

define inc(x) =	<start!code
		aos	access(x);
		end>;

define dec(x) =	<start!code
		sos	access(x);
		end>;

! end magic code;

define upto = <step 1 until>;
define tec = <9>;
define iml = <10>;
define dm = <5>;
define tb = <"	">;
define crlf = <"
">;
	begin
ifc tops20!switch thenc 
	define extguy = <".">; 
	define eolguy = <'12>;
	define	savguy = <"exe">;
		elsec
	define extguy = <";">; 
	define eolguy = <'37>;
	define	savguy = <"sav">;
		endc

external integer !skip!;
integer top, tsize, dsize, nfiles, dnum, rev;
string str, mydir;		! mydir contains the name of the directory
				  you are looking at if not your own;
string restart;			! used to generate files when you continue;
string array dir, file [-1:500]; ! -1 and 0 are for help files;
string array lstwrite [1:500];
integer array size, protect, rddate, crdate, wrdate , point [1:500];
integer array disparr [1:3, 1:500];	! which things get displayed;
boolean array deleted , archived , kill [1:500];
integer array tab [1 : '177];
boolean sflag;		! true if showing size, false if showing protection;
integer fflag1, fflag2;	! 0 for read date, 1 for write date, 2 for creation;
integer cntl!o!flag;	! this will get set when a control o is hit;
boolean quick!flag;	! true if you hit a space bar at entering;
integer term!type;
boolean purge!flag;	! true if you have requested at least one file purged;

integer array fdb!block [0 : 25];	! holds the fdb;
integer array dirsh!num [1 : 10];	! directory numbers for dirsh;
string array dirsh!name [1 : 10];	! directory name;
integer dirsh!max;			! number of entries in dirsh;
string truline;				! the last topeline displayed;
! The basic storage format is as follows:

	the names of all the files are held in file [i].

	if the file is deleted, deleted [i] is true.

	the size is in size [i].

	creation date is in crdate [i]

	write date is in wrdate [i] 		( both in internal format)

	last writer (directory name) is in lstwrite [i]
	
	point [i] contains a pointer to which file is actually located
	in that spot (i).

	total number of all files is in nfiles, total number of deleted
	files is in dnum.

	total number of pages is in tsize, total number of deleted 
	pages is in dsize.

	top contains the index number of the first file on the display
	screen.

	tab [i] contains the index number of the first file starting
	with the charcter i (i.e. the ascii representation of the 
	character);
simple boolean procedure archd ;
	if '200000000000 land fdb!block ['17] then
		return (true)
	else
		return (false);
boolean procedure deld;
	if '40000000000 land fdb!block [1] then
		return (true)
	else
		return (false);
define create = <fdb!block ['13]>,
	write = <fdb!block ['14]>,
	read = <fdb!block ['15]>,
	proto = <('777777 land fdb!block [4])>,
	who = <(fdb!block [6] lsh -18)>;
simple procedure zap!buffer;
	quick!code
	movei	1,'777777;
	cfobf;
	end;
simple procedure cntl!o!int;
	cntl!o!flag _ true;

simple procedure set!cntl!o;
begin
psimap (2, cntl!o!int, 0, 3);
enable (2);
ati (2,"O" - '100);
end;
simple procedure asc;		! switches from binary to ascii mode;
	begin
	if term!type = dm then outchr ('35);	! if dm then roll mode;
	turnof;
	end;

simple procedure bin;	! switches from ascii to binarry mode;
	sfmod ('101, rfmod ('101) land '777777777477);
simple procedure wait!for!cr (string  prompt);
	while true do
		begin
		integer i;
		i _ inchrw;
		if i = '15 then i _ inchrw;
		if i = "?" then outstr ("Confirm with Carriage Return " 
					& prompt)
		else if i = '40 or i = '11 then
		else if i neq eolguy then outstr ("  ?")
		else return;
		end;
simple procedure no!dollar!sign;
	begin
	integer cw1, cw2;
	rfcoc ('101, cw1, cw2);
	sfcoc ('101, cw1, cw2 land '777777177777);
	end;
simple string procedure construct!name (integer jfn);
	begin
	string res;
	integer flags;
	flags _ jfn lsh -18;	
	jfn _ jfn land '777777;
	ifc tops20!switch thenc
		res _   jfns (jfn, '100000000000) & ":";
	elsec
		res _ "";
	endc;
	res _ res & "<" & (if '100000 land flags then "*" else 
		jfns (jfn, '10000000000)) & ">";
	res _ res & (if '40000 land flags then "*" else
		jfns (jfn, '1000000000));
	res _ res & "." & (if '20000 land flags then "*" else
		jfns (jfn, '100000000));
	res _ res & extguy & (if '10000 land flags then "*" else
		jfns (jfn, '10000000));
	return (res);
	end;
simple string procedure dirsh (integer num);
	begin
	integer i;
	for i _ 1 upto dirsh!max do
		if num = dirsh!num [i] then
			return (dirsh!name [i]);
	if dirsh!max geq 10 then
		return (dirst (num))
	else
		begin
		inc (dirsh!max);
		dirsh!num [dirsh!max] _ num;
		return ((dirsh!name [dirsh!max] _ dirst (num)));
		end;
	end;
simple integer procedure get!group;
	! returns the jfn of a file group.  doesn't let you out till you
		give a legal one;
	while true do
		begin
		no!dollar!sign;
		if pbin = "?" then
			outstr ("  A file name" & '15 & '12)
		else
			begin
			integer jfn, flags;
			bkjfn ('100);
			jfn _ gtjfnl (null, '101123777775, '100000101, null
				, null, "*", "*", "*", null, 0);
			if not !skip! then
				begin
				bkjfn ('100);
				if pbin = '33 then
					begin
					outchr (" ");
					wait!for!cr (null);
					end;
				restart _ construct!name (cvjfn (jfn));
				return (jfn)
				end
			else
				outstr ("  ? ");
			end;
		end;

forward procedure refresh (integer i);
procedure set (integer jfn);	! main setup procedure;
	begin
	integer pchr;
	purge!flag _ pchr _ nfiles _ dnum _ tsize _ dsize _ 0;
	arrclr (file);
	arrclr (archived);
	arrclr (deleted);
	arrclr (kill);
	arrclr (tab);
	arrclr (size);
	arrclr (protect);
	arrclr (rddate);
	arrclr (wrdate);
	arrclr (crdate);
	arrclr (lstwrite);
	arrclr (point);
	arrclr (dir);
! These are for the help system;
ifc tops20!switch thenc
	dir [0] _ "HLP:";  dir [-1] _ "DOC:";
	file [0] _ "DIRED.HLP";
	file [-1] _ "DIRED.UPDATES";
elsec ifc sri!switch thenc
	dir [0] _ dir [-1] _ "<HELP>";
	file [0] _ "DIRED.HLP";
	file [-1] _ "DIRED.UPDATES";
elsec ifc imsss!switch thenc
	dir [0] _ dir [-1] _ "<SHADOW>";
elsec
	dir [0] _ dir [-1] _ "<ACHENBACH>";
endc
	file [-1] _ "EDIR.UPDATES";
	file [0] _ "EDIR.HELP";
endc endc

	ifc tops20!switch thenc
		mydir  _ jfns (jfn , '110000000001);
	elsec			! use device (structure) and directory name;
		mydir  _ jfns (jfn , '10000000001);
	endc			! supress everything but directory name;

	outstr ("Reading Directory");

	do	begin
		integer i;
		string fauth;
		define gfust="'104000000550";
		inc (nfiles);
		if nfiles mod 10 = 0 then outchr (".");
		ifc tops20!switch thenc
			file [nfiles] _ jfns (jfn, '211120000001);
		elsec
			file [nfiles] _ jfns (jfn, '11120000001);
		endc
		dir [nfiles] _ scan (file [nfiles], 2, i);
		gtfdb (jfn, fdb!block);
		size [nfiles] _ sizef (jfn);
		tsize _ tsize + size [nfiles];
		! create new string to mung;
		fauth _ " ";
		fauth _ fauth&"                                     ";
		fauth _ fauth&" ";
		! fauth _ Gfust(.gfauth,Jfn);
		start!code;
			hrrz 1,jfn;
			move 2,fauth;
			Gfust;		! get file author;
			movei 1,'40;
			idpb 1,2;
		end;
		lstwrite [nfiles] _  fauth [1 for 15];
		if length (lstwrite [nfiles]) < 3 then 
			lstwrite [nfiles] _ lstwrite [nfiles] & "    	"
		else if length (lstwrite [nfiles]) < 8 then
			lstwrite [nfiles] _ lstwrite [nfiles] & "	";
		protect [nfiles] _ proto ;
		rddate [nfiles] _ read ;
		wrdate [nfiles] _ write;
		crdate [nfiles] _ create;

		disparr [1, nfiles] _ if sflag then size [nfiles]
						else protect [nfiles];
		disparr [2, nfiles] _ case fflag1 of
			(rddate [nfiles],
			wrdate [nfiles],
			crdate [nfiles]);
		disparr [3, nfiles] _ case fflag2 of
			(rddate [nfiles],
			wrdate [nfiles],
			crdate [nfiles]);

		point [nfiles] _ nfiles;
		archived [nfiles] _ archd ;
		if (deleted [nfiles] _ deld) then
			begin
			dsize _ dsize + size [nfiles];
			inc (dnum);
			end;
		if pchr neq file [nfiles] then
			begin
			pchr _ file [nfiles];
			tab [pchr] _ nfiles;
			end;
		end until not gnjfn (jfn);
	outstr (crlf);
	release (jfn);
	end;
simple procedure set!mask ;
 	! sets a new file mask.  This is the routine called by the "M"
		command;

	begin
	integer jfn, log, con, tty;
	gjinf (log, con, tty);
	setcur (0,21);
	dpyout;
	asc;
	do	begin
		outstr ("(CR) to edit directory " & dirst (con) & "
or enter a file mask ");
		jfn _ get!group;
		end until jfn neq -1;
	set (jfn);
	refresh (1);
	end;
! the following two procedures are for formating.  Form fills the
	display buffer with charcters and commands for the proper
	display format.  Line0 updates the top line;

procedure form (integer j; boolean verbose);
	! dpyStr's a line in the proper format;
	! verbose=true if whole line needs to be redisplayed;
	begin
	string str;
	integer i;
	i _ point [j];
	str _ (if deleted [i] then "*D*" 
		else if archived [i] then "*A*" 
		else if kill [i] then "*K*" else "   ");
	if verbose then dpyStr (6 & lnot (25) & lnot (cy + 1) 
		& (if sflag then cvs (disparr [1,i]) else cvos (disparr [1,i])) & 
		"	" & lstwrite [i] & "	" &
		(if disparr [2,i] then
		odtim (disparr [2,i], '245400000000) else "     ----    ")
		& "	" &
		(if disparr [3,i] then
		odtim (disparr [3,i], '245400000000) else "     ----    ")
		& 6 & lnot (0) & lnot (cy + 1) & str
		& file [i] & " ")
	else dpyStr ( 6 & lnot (0) & lnot (cy + 1) & str );
	dpyout;
	end;
procedure line0;
	begin
	string linetext; integer i;
	doHOME;
	linetext _ cvs (nfiles - dnum) & " files, " & cvs (tsize - dsize)
		& " pp." & "   (Deleted: " & cvs (dnum) & " files, " & 
		cvs (dsize) & " pp.)" & "   " & mydir;
	for i_1 upto 79 min length(linetext) do
		if linetext[i for 1] = truline[i for 1] then
			DpyChr( 1 )
		else DpyChr( linetext[i for 1] );
	if length(truline) > length(linetext) then DoEEOL;
	truline_linetext;
	end;
procedure refresh (integer start);
	begin
	integer i, j, k;
	cntl!o!flag _ false;
	top _ start;
	dpyIni;
	term!type _ gttyp ('101, j);	! what kind of terminal are we on?;
	doCP;  truline_null;
	line0;
	j _ if nfiles - start > 19 then 20 else nfiles - start + 1;
	for i _ 1 upto j do
		begin
		if cntl!o!flag then 
			begin
			zap!buffer;
			done;
			end;
		form (i + start - 1,true);
		end;
	dpyOut;
	bin;
	setCur (0,1);
	dpyout;
	end;
procedure pwindow;
	if nfiles - top > 15 then
		begin
		integer i, j, k;
		cntl!o!flag _ false;
		j _ if cy > 15 then cy - 15 else 1;
		setCur (0, 1);
		dpyNch (15, '25);	! delete 15 lines;
		setCur (0, 5);
		top _ top + 15;
		k _ if top + 19 > nfiles then nfiles else top + 19;
		for i _ top + 5 upto k do
			if cntl!o!flag then
				begin
				zap!buffer;
				done;
				end
			else
				form (i,true);
		dpyOut;
		bin;
		setCur (0, j);
		dpyout;
		end;
procedure mwindow;
	if top neq 1 then
		begin
		integer i, j, k;
		cntl!o!flag _ false;
		i _ if top < 16 then top - 1 else 15;
		j _ if cy < 6 then cy + i else 20;
		top _ top - i;
		setCur (0, 21 - i);
		doEEOP;
		setCur (0, 1);
		dpyNch (i, '23);	! insert i lines;
		doHome;
		for k _ top upto top + i - 1 do
			if cntl!o!flag then
				begin
				zap!buffer;
				done;
				end
			else
				form (k,true);
		dpyOut;
		bin;
		setCur (0, j);
		dpyout;
		end
	else if cy = 0 then
		begin
		setcur (0,1);
		dpyout;
		end;
simple procedure allback;
	if top < 17 then
		mwindow
	else
		refresh (1);
simple procedure allforward;
	if nfiles - top > 30 then
		refresh (nfiles - 15)
	else 	pwindow;
simple procedure prompt (integer i);
	if i + top - 1 leq nfiles then
		begin
		setcur (0,i);
		dpyout;
		if i < 1 then mwindow
		else if i > 20 then pwindow;
		end
	else
		begin
		setcur (0, nfiles - top + 1);
		dpyout;
		end;
simple procedure refer(boolean verbose);
	begin
	setCur (0, cy - 1);
	form (top + cy, verbose);
	dpyOut;
	prompt (cy);
	end;
procedure delet1 (integer i);
	if not kill [i] then
		begin
		integer jfn;
		jfn _ gtjfn (dir [i] & file [i], '100001000000);
		if not !skip! then 
			begin
			delf (jfn);
			if not !skip! then
				begin
				inc (dnum);
				dsize _ dsize + size [i];
				deleted [i] _ true;
				end;
			end;
		release (jfn);
		end;
procedure delete (integer i);
	begin
	integer j;
	delet1 (i);
	j _ cy;
	refer(false);
	line0;
	prompt (j + 1);
	end;
PROCEDURE delete!all;
	BEGIN "delete!all" 
	integer i;
	for i _ 1 upto nfiles do
		delet1 (i);
	refresh (1);
	END "delete!all";
procedure undel1 (integer i);
	begin
	integer jfn;
	jfn _ gtjfn (dir [i] & file [i], '101001000000);
	if (not !skip! and deleted [i]) or kill [i] then
		begin
		undelete (jfn);
		dec (dnum);
		dsize _ dsize - size [i];
		kill [i] _ deleted [i] _ false;
		end;
	release (jfn);
	end;
procedure undel (integer i);
	begin
	integer j;
	undel1 (i);
	j _ cy;
	refer(false);
	line0;
	prompt (j + 1);
	end;	
procedure undel!all;
	begin
	integer i;
	purge!flag _ false;
	for i _ 1 upto nfiles do
		undel1 (i);
	refresh (1);
	end;
ifc not imsss!switch thenc
simple procedure archive (integer jfn);
	start!code
	move	1,jfn;
	hrli	1,'17;		! archive word;
	hrlzi	2,'200000;	! archive bit;
	move	3,2;		! set this bit;
	chfdb;
	end;
simple procedure reset (integer jfn);
	start!code
	move	1,jfn;		! archive word again;
	hrli	1,'17;
	hrlzi	2,'200000;
	setz	3,;		! set the archive bit to 0;
	chfdb;
	end;
simple procedure arch1 (integer i);
	begin
	integer jfn;
	jfn _ gtjfn (dir [i] & file [i], '100001000000);
	if not !skip! then 
		begin
		archive (jfn);
		archived [i] _ true;
		end;
	release (jfn);
	end;
simple procedure arch (integer i);
	begin
	integer j;
	arch1 (i);
	refer(false);
	prompt (cy + 1)
	end;
simple procedure arch!all;
	begin
	integer i;
	for i _ 1 upto nfiles do
		arch1 (i);
	refresh (1);
	end;
simple procedure res1 (integer i);
	begin
	integer jfn;
	jfn _ gtjfn (dir [i] & file [i], '100001000000);
	if not !skip! then
		begin
		reset (jfn);
		archived [i] _ false;
		end;
	release (jfn);
	end;
simple procedure rest (integer i);
	begin
	res1 (i);
	refer(false);
	prompt (cy + 1);
	end;
simple procedure rest!all;
	begin
	integer i;
	for i _ 1 upto nfiles do
		res1 (i);
	refresh (1);
	end;

! all of the next three pages cannot be used at sri, since they don't
  have the purge jsys.  I question whether this should be used at all;

ifc not sri!switch thenc

simple boolean procedure yes!or!no (string prompt);
	while true do
		begin
		integer char;
		outstr (prompt);
		char _ inchrw;
		if char = "y" or char = "Y" then
			return (true)
		else if char = "n" or char = "N" then
			return (false)
		else outstr (" ? ");
		end;
simple procedure purge (string file!name);
	begin
	integer jfn;
	outstr (crlf & file!name);
	if yes!or!no (" (Y or N) ") then
		begin
		jfn _ gtjfn (file!name, '100001000000);
			start!code
			move	1,jfn;
			prge;
			 jfcl;
			end;
		end
	else
		outstr ("   XXX");
	end;
simple procedure kill1 (integer i);
	if not kill [i] then
		begin
		purge!flag _ kill [i] _ true;
		inc (dnum);
		dsize _ dsize + size [i];
		end;
simple procedure kill!file (integer i);
	begin
	integer j;
	j _ cy;
	kill1 (i);
	refer(false);
	line0;
	prompt (j + 1);
	end;
simple procedure kill!all;
	begin
	integer i;
	purge!flag _ true;
	for i _ 1 upto nfiles do
		kill1 (i);
	refresh (1);
	end;

endc
endc
procedure typin (string str);	! simulates a type in str;
! the string str is sti'ed into the input buffer, making it look as
if str were typed in at the terminal;
	begin
	integer char;
	do	begin
		char _ lop (str);
		start!code;
		movei	1,'100;
		move	2,char;
		sti;
		end;
		end	until not length (str);
	end;
procedure list (integer which);
	begin
	integer j;
	j _ cy;
	setCur (0, 21);
	dpyOut;
	asc;
	ifc not imsss!switch thenc
	outstr ("
Type ""POP"" to return to DIRED
");
	endc
	start!code 
	movei	1,200;
	disms;
	end;			! pause to let buffer clear;
	ifc imsss!switch thenc
	typin ("S");
	elsec
	typin ("list ");
	endc
	typin (dir [which] & file [which] & "," & '15);
	ifc imsss!switch thenc
	runprg ("<subsys>spool.sav", 0, true);
	elsec
	runprg ("<system>exec."&savguy, 0, true);
	endc
	refresh (top);
	prompt (j);
	end;
procedure tv (integer which);
	begin
	integer j;
	j _ cy;
	setcur (0, 21);
	dpyout;
	ifc tops20!switch thenc
		typin ("" & dir[which] & file[which] & '15);
		runprg ("sys:emacs."&savguy, 0, true);
		set!cntl!o;
	elsec
	ifc sri!switch thenc
		typin (dir [which] & file [which] & '33 & '33);
		runprg ("<subsys>tvedit."&savguy, 0, true);
	elsec
		typin (dir [which] & file [which] & '33 & '33);
		runprg ("<subsys>tv.sav", 0, true);
	endc   endc;
	refresh (top);
	prompt (j);
	end;
procedure skip;
	begin
	integer i, j;
	j _ inchrw;
	if "a" leq j leq "z" then j _ j - '40;
	if "!" leq j leq "^" then
		if (-1 < tab [j] - top < 20) then 
			prompt (tab [j] - top + 1)
		else 
			if tab [j] then refresh (tab [j]);
	end;
procedure type (integer i);
	begin
	integer jfn, bchr, eof, j, page;

	cntl!o!flag _ false;
	jfn _ openfile (dir [i] & file [i], "ROE");
	if not !skip! then
		begin
		setinput (jfn, 200, bchr, eof);
		page _ 1;
		j _ cy;
		doCP;
		dpyOut;
		asc;
		outstr ("*********************** " 
			& jfns (jfn, 0) & " ***************************
");
		do	
			begin
			outstr (input (jfn, 1) & "
");
			if bchr = '14 then
			 	outstr ("
page " & cvs (page _ page + 1) & " --------------------------------------

");
			if cntl!o!flag then
				begin
			        zap!buffer;
				outstr ("^O");
				done;
				end;
		end until eof;
		outstr ("
*********************** " & jfns (jfn, 0) & " **************************
(CR) to return to editor");
		cfile (jfn);
		do until inchrw = eolguy; 	! sit until a crlf;
		bin;
		refresh (top);
		prompt (j);
		end;
	end;
simple integer procedure cvchar (integer char);
 ! input character conversion;
 !  ESC => set Edit bit on next char;
 !  CR  => LF;
 ! on TEC, treat some chars specially;
 ! convert lowercase to upper;
	begin
	if char = '33 then char _ inchrw + '200;
	if char land '177 = '15 then char _ char - 3;
	if term!type = tec then
		if char = "d" then return ('33)
		else if char = "c" then return ('12)
		else if char = "d" + '200 then return ('233)
		else if char = "c" + '200 then return ('212);
	if "a" leq ('177 land char) leq "z" then 
		return (char - '40)
	else 
		return (char);
	end;
simple procedure help;
	begin
	integer j;
	j _ cy;
	while true do
		begin
		integer char;
		setcur (0, 21);
		dpystr ("C, U or ?:");
		dpyout;
		char _ cvchar (inchrw);
		if char = "?" then
			begin
			dpystr ("
C for command summary, U for Updates, ^O aborts typeout");
			dpyout;
			end
		else if char = "C" then
			begin
			dpystr ("
Reading help file...");
			setcur (0,j);
			dpyout;
			type (0);
			return;
			end
		else if char = "U" then
			begin
			dpystr ("
Reading help file...");
			setcur (0,j);
			dpyout;
			type (-1);
			return;
			end;
		end;
	end;
simple boolean procedure sizeok (reference integer i, j);
	return ( rev xor (size [point [i]] geq size [point [j]]));
simple boolean procedure writeok (reference integer i, j);
	return (rev xor (wrdate [point [i]] geq wrdate [point [j]]));
simple boolean procedure alphok (reference integer i, j);
	return (rev xor (alphabetized (file [point [i]], file [point [j]])));
procedure order;
	begin
	integer which;
	setcur (0, 21);
	dpyout;
	asc;
	outstr ("
order by size, writedate, or alphabetic (s/w/a):");
	which _ cvchar (inchrw);
	if which = "S" or which = "W" or which = "A" then
		begin
		outstr ("
reverse order? (y/n):");
		rev _ cvchar (inchrw) = "Y";
		bin;
		if which = "S" then
			intsort (point, 1, nfiles, sizeok)
		else if which = "W" then
			intsort (point, 1, nfiles, writeok)
		else 
			intsort (point, 1, nfiles, alphok);
		end;
	refresh (1);
	end;
procedure change!format;
	begin
	integer char;
	dohome;
	docp;
	dpyout;
	asc;
	outstr ("
Current format is:
file name	" & (if sflag then "size        " else "protection  ") &
	"author	" & (case fflag1 of ("read", "write", "create")) &
	"	" & (case fflag2 of ("read", "write", "create")) & "
		 ^^^             	^^^	^^^
		        setable fields

field 1 (size, protection) (s,p) [s]");
	sflag _ true;
	fflag1 _ 1;
	fflag2 _ 0;
	char _ cvchar (inchrw);
	if not char = '33 then
		begin
		if char = "P" then sflag _ false;
		outstr ("
field 2 (read, write, create) (r,w,c) [w]");
		char _ cvchar (inchrw);
		if not char = '33 then
			begin
			if char = "R" then fflag1 _ 0
			else if char = "C" then fflag1 _ 2;
			outstr ("
field 3 (read, write, create) (r,w,c) [r]");
			char _ cvchar (inchrw);
			if char = "W" then fflag2 _ 1
			else if char = "C" then fflag2 _ 2;
			end;
		end;

	for char _ 1 upto nfiles do
		begin
		disparr [1,char] _ (if sflag then size [char] else protect [char]);
		disparr [2, char] _ case fflag1 of 
			(rddate [char], wrdate [char], crdate [char]);
		disparr [3,char] _ case fflag2 of
			(rddate [char], wrdate [char], crdate [char]);
		end;
	end;
simple procedure dump;
	begin
	integer i, jfn;
	boolean sflg, aflg, cflg, wflg, pflg, rflg;
	string opts;
	setcur (0,21);
	dpyout;
	asc;
	outstr ("dump directory onto file:");
	jfn _ openfile (null, "wc");
	out (jfn, "
DIRECTORY " & MYDIR & "  AS OF " & ODTIM (-1,-1) & "

");
	while true do
		begin
		sflg _ wflg _ aflg _ cflg _ pflg _ rflg_ false;
		outstr ("options (or ?):");
		i _ inchrw;
		if i = "?" then
			outstr ("
Enter the letters for the options you want:

s	size
P	protection
r	last read date
a	author
c	creation date
w	last write date
")
		else
			done;
		end;
	bkjfn ('100);
	opts _ intty;
	while length (opts) do
		begin
		i _ cvchar (lop (opts));
		if i = "S" then sflg _ true
		else if i = "W" then wflg _ true
		else if i = "A" then aflg _ true
		else if i = "C" then cflg _ true
		else if i = "P" then pflg _ true
		else if i = "R" then rflg _ true;
		end;
	
	for i _ 1 step 1 until nfiles do
		begin
		if deleted [point [i]] then 
			out (jfn, "*D*")
		else if archived [point [i]] then
			out (jfn, "*A*")
		else
			out (jfn, "   ");
		out (jfn, file [point [i]] );
		out (jfn, "                         " [length (file [point[i]]) to inf] & "  ");
		if sflg then out (jfn, cvs (size [point [i]]) & tb);
		if pflg then out (jfn, cvos (protect [point [i]]) & tb);
		if aflg then out (jfn, lstwrite [point [i]] & tb);
		if wflg then out (jfn, odtim (wrdate [point [i]], '245401000000) & tb);
		if rflg	then out (jfn, odtim (rddate [point [i]], '245401000000) & tb);
		if cflg then out (jfn, odtim (crdate [point [i]], '245401000000) & tb);
		out (jfn, crlf)
		end;
	cfile (jfn);
	refresh (top);
	end;
simple procedure exec;
	begin
	dohome;
	docp;
	dpyout;
	asc;
	runprg ("<system>exec."&savguy,0, true);
	refresh (top);
	end;
simple procedure finish;
	begin
	integer jfn;
	dohome;
	docp;
	dpyout;
	asc;
	ifc not sri!switch and not imsss!switch thenc
	if purge!flag then
		begin
		integer i;
		outstr ("Files to be purged.  ""Y"" to purge, ""N"" to abort.
");
		for i _ 1 upto nfiles do
			if kill [i] then
				purge (file [i]);
		purge!flag _ false;
		end;
	endc
	outstr ("
F I N I S H E D " & restart & "

	CONTINUE to start over
" );
	quick!code haltf end;
	jfn _ gtjfn (restart, '102103000000);
	bin;
	if !skip! then set!mask
	else 
		begin
		set (jfn);
		refresh (1);
		end;
	end;
integer jfn, edir;
ifc sri!switch thenc
	edir _ cvsix ("DIRED");
elsec
	edir _ cvsix ("EDIR");
endc

start!code
move	1,edir;
setnm;
end;

setbreak (1, '15 & '37 & '14, '12, "IN");
setbreak (2, ">", null, "ina");

set!cntl!o;

! first get the setup jfn.  If edir was terminated with a cr, use "*.*!*"
	other wise get a file group;
ifc tops20!switch thenc
	begin
		integer ch;
		define rscan = '104000000500;
		start!code
		setz	1, ;
		rscan;
		 cai;		
		end;
	do until (ch _ inchrw) = '40 or ch = '12;
		bin;
		end;
	endc;
bkjfn ('100);
if pbin = eolguy then
	begin
	jfn _ gtjfn ("*.*" & extguy & "*", '101103777775);
	restart _ "*.*" & extguy & "*";
	end
	else
	jfn _ get!group;

sflag _ true;
fflag1 _ 1;
fflag2 _ 0;
set (jfn);
refresh (1);
while true do
	begin "while"
 	case cvchar (inchrw) of begin 
		[0] ;
		["!"]		begin
				dohome;
				doeeop;
				dpyout;
				asc;
				bail;
				refresh (top);
				end;
		["!" + '200]	begin
				dohome;
				doeeop;
				dpystr ("
ddt:
");
				dpyout;
				asc;
				ddt;
				refresh (top);
				end;
		["V" - '100]				! ^V = W;
		["+"]["W"]	pwindow;
		["V" + '200]				! M-V = -;
		["-"]		mwindow;
		["+" + '200]
		["W" + '200]	allforward;
		["-" + '200]	allback;
		['212]		prompt (20);
		[" "]					! space = LF;
		["N" - '100]				! ^N = LF;
		['12]		prompt (cy + 1);
		["H" - '100]['177]			! backspace = ^;
		["P" - '100]				! ^P = ^;
		["^"]		prompt (cy - 1);
		["H" - '100]['177 + '200]				
		["^" + '200]	prompt (1);
		["L" - '100]				! ^L M-N;
		["N" + '200]	refresh (top);		! buckey N;
		["N"]		refer(true);
		["C"]		begin
				change!format;
				refresh (top);
				end;
		["D"]		delete (point [top + cy - 1]);
		["D" + '200]	delete!all;
		["U" + '200]	undel!all;
		["U"]		undel (point [top + cy - 1]);
		ifc not imsss!switch thenc

		["A"]		arch (point [top + cy - 1]);
		["A" + '200]	arch!all;
		["R"]		rest (point [top + cy - 1]);
		["R" + '200]	rest!all;
		ifc not sri!switch thenc

		["K"]		kill!file (point [top + cy - 1]);
		["K" + '200]	kill!all;

		endc
		endc
		["L"] 		list (point [top + cy - 1]);
		["E"]		tv (point [top + cy - 1]);
		["T"]		type (point [cy + top - 1]);
		["S"]		skip;
		["O"]		order;
		["P"]		dump;
		["X"]		exec;
		["M"]		set!mask;
		["H"]["?"]	help;
		["F"]		finish;
		['377]	
		else		print('7&'0)
		end;
	end "while";
	end;
end "dired"