Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/dired.sai
There are no other files named dired.sai in the archive.
COMMENT **CONTENTS**
Modified 9-Jan-85 Ian@NIC
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 next!window
21 procedure previous!window
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!region
29 procedure undel1 (integer i)
30 procedure undel (integer i)
31 procedure undel!region
32 simple procedure archive (integer jfn)
simple procedure visible (integer jfn)
33 simple procedure reset (integer jfn)
34 simple procedure arch1 (integer i)
35 simple procedure arch (integer i)
36 simple procedure arch!region
37 simple procedure res1 (integer i)
38 simple procedure rest (integer i)
39 simple procedure rest!region
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 " [TOPS-20 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 "src:<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, mark;
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:1000]; ! -1 and 0 are for help files;
string array lstwrite [1:1000];
integer array size, protect, rddate, crdate, wrdate , point [1:1000];
integer array disparr [1:3, 1:1000]; ! which things get displayed;
boolean array deleted, invisible, kill [1:1000];
boolean array archived,archive!requested,retrieval!requested,offline [1:1000];
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!count; ! number OF files you've requested be 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 '100000000 land fdb!block [1] then return(true) else return(false);
simple boolean procedure offd;
if '20000000 land fdb!block [1] then return(true) else return(false);
simple boolean procedure arcreqd;
if '200000000000 land fdb!block ['22] then return(true) else return(false);
simple boolean procedure deld;
if '40000000000 land fdb!block [1] then return(true) else return(false);
simple boolean procedure invis;
if '40000000 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 beep;
quick!code
movei 1,7;
pbout;
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 _ gtjfnx (null, '101127777775, '100000101,
NULL, null, "*", "*", null, NULL,
0, '10000000000);
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!count _ pchr _ nfiles _ dnum _ tsize _ dsize _ mark _ 0;
arrclr (file);
arrclr (archived);
arrclr (archive!requested);
ARRCLR (retrieval!requested);
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;
archive!requested [nfiles] _ arcreqd;
offline [nfiles] _ offd;
invisible [nfiles] _ invis;
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 offline [i] then "O" ELSE " ")
& (IF retrieval!requested [i] OR archive!requested [i] THEN "R"
ELSE if archived [i] then "A" ELSE " ")
& (if invisible [i] then "I" else " ")
& (if deleted [i] then "D" 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 next!window;
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 previous!window;
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 prompt (integer i);
if i + top - 1 leq nfiles then
begin
setcur (0,i);
dpyout;
if i < 1 then previous!window
else if i > 20 then next!window;
end
else
begin
setcur (0, nfiles - top + 1);
dpyout;
end;
simple procedure first!file;
begin;
if top neq 1 then refresh(top _ 1);
prompt(1);
end;
simple procedure last!file;
begin;
if top < (nfiles - 20) THEN refresh(top _ (nfiles - 20) max 1);
prompt(20);
end;
simple procedure refer(boolean verbose);
begin
setCur (0, cy - 1);
form (top + cy, verbose);
dpyOut;
prompt (cy);
end;
PROCEDURE say (STRING stuff);
BEGIN
setcur(0, 21);
dpystr(stuff);
dpyout;
END;
SIMPLE PROCEDURE bang;
begin
dohome;
doeeop;
dpyout;
asc;
bail;
refresh (top);
end;
SIMPLE PROCEDURE meta!bang;
begin
dohome;
doeeop;
dpystr ("
ddt:
");
dpyout;
asc;
ddt;
refresh (top);
end;
procedure delet1 (REFERENCE integer i);
if not (kill [i] or deleted [i]) then
begin
integer jfn;
jfn _ gtjfnx (dir [i] & file [i], '100001000000, '377777377777,
null, null, null, null, null, null,
0, '10000000000);
if not !skip! then
begin
delf (jfn);
if not !skip! then
begin
inc (dnum);
dsize _ dsize + size [i];
deleted [i] _ true;
end;
release (jfn);
end
else beep;
end;
SIMPLE PROCEDURE unvisible (INTEGER jfn);
START!CODE
move 1,jfn;
hrli 1,'1; ! control word;
hrlzi 2,'40; ! invisible bit;
move 3,2; ! set it;
CHFDB;
END;
procedure vanis1 (REFERENCE integer i);
if not invisible [i] then
begin
integer jfn;
jfn _ gtjfnx (dir [i] & file [i], '101001000000, '377777377777,
null, null, null, null, null, null,
0, '10000000000);
if not !skip! then
begin
unvisible(jfn);
invisible [i] _ true;
release(jfn);
end
else beep;
end;
SIMPLE PROCEDURE visible (INTEGER jfn);
START!CODE
move 1,jfn;
hrli 1,'1; ! control word;
hrlzi 2,'40; ! invisible bit;
setz 3,; ! clear it;
CHFDB;
END;
procedure visib1 (REFERENCE integer i);
if invisible [i] then
begin
integer jfn;
jfn _ gtjfnx (dir [i] & file [i], '101004000000, '377777377777,
NULL, NULL, NULL, NULL, NULL, NULL,
0, '10000000000);
IF NOT !skip! THEN
BEGIN
visible (jfn);
release (jfn);
invisible [i] _ FALSE;
release(jfn);
END
else beep;
end;
simple procedure archive (integer jfn);
start!code
move 1,jfn;
movei 2,'0; ! function CODE, .ARRAR ;
movei 3,'1; ! .ARSET (request archival)
ARCF;
hrli 1,'1; ! control word;
hrlzi 2,'40; ! invisible bit;
move 3,2; ! set it invisible;
CHFDB;
end;
simple procedure arch1 (REFERENCE integer i);
if not archive!requested [i] then
begin
integer jfn;
jfn _ gtjfn (dir [i] & file [i], '100001000000);
if not !skip! then
begin
archive(jfn);
archive!requested [i] _ true;
if not invisible [i] then
begin
unvisible(jfn);
invisible [i] _ true;
end;
release (jfn);
end
else beep;
end;
SIMPLE PROCEDURE unarchive (INTEGER jfn);
START!CODE
move 1,jfn; ! archive word again;
setzb 2,3; ! .ARRAR function code, AC3/0 clears request;
ARCF;
END;
simple procedure rest1 (REFERENCE integer i);
if archive!requested [i] then
begin
integer jfn;
jfn _ gtjfnx (dir [i] & file [i], '100001000000, '377777377777,
null, null, null, null, null, null,
0, '10000000000);
if not !skip! then
begin
unarchive(jfn);
visible(jfn);
archive!requested [i] _ invisible [i] _ FALSE;
release(jfn);
end
else beep;
end;
procedure undel1 (REFERENCE integer i);
if deleted [i] then
begin
integer jfn;
jfn _ gtjfnx (dir [i] & file [i], '101001000000, '377777377777,
null, null, null, null, null, null,
0, '10000000000);
if not !skip! then
begin
undelete (jfn);
dec (dnum);
dsize _ dsize - size [i];
kill [i] _ deleted [i] _ false;
release(jfn);
end
else beep;
end
else if kill [i] then
begin
dec (dnum);
dsize _ dsize - size [i];
kill [i] _ false;
dec (purge!count);
end;
SIMPLE PROCEDURE save!mark;
mark _ cy;
PROCEDURE do!region (REFERENCE PROCEDURE funct);
BEGIN
integer i;
IF mark > 0 THEN for i _ (mark MIN cy) upto (mark MAX cy) DO funct(i)
ELSE for i _ 1 upto nfiles DO funct(i);
refresh (1);
end;
PROCEDURE then!next (REFERENCE PROCEDURE funct);
begin
integer j;
funct(POINT[top + cy - 1]);
j _ cy;
refer(false);
line0;
prompt(j + 1);
end;
PROCEDURE then!previous (REFERENCE PROCEDURE funct);
begin
integer i, j;
i _ POINT[cy + top - 1];
funct(i);
j _ cy;
refer(false);
line0;
prompt(j - 1);
end;
PROCEDURE then!stay (REFERENCE PROCEDURE funct);
BEGIN
INTEGER i;
i _ POINT[cy + top - 1];
funct(i);
refer(false);
prompt(cy);
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 (REFERENCE integer i);
if not kill [i] then
begin
kill [i] _ true;
inc(purge!count);
inc (dnum);
dsize _ dsize + size [i];
end;
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 (REFERENCE integer i);
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 [i] & file [i] & "," & '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 (REFERENCE integer i);
begin
integer j;
j _ cy;
setcur (0, 21);
dpyout;
ifc tops20!switch thenc
typin ("" & dir[i] & file[i] & '15);
runprg ("sys:emacs."&savguy, 0, true);
set!cntl!o;
elsec
ifc sri!switch thenc
typin (dir [i] & file [i] & '33 & '33);
runprg ("<subsys>tvedit."&savguy, 0, true);
elsec
typin (dir [i] & file [i] & '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 (REFERENCE 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;
say("C, U or ?:");
char _ cvchar (inchrw);
IF char = ("J" - '100) OR char = ("D" - '100) OR
char = ("G" - '100) OR char = ("U" - '100) THEN
BEGIN
refresh(top);
prompt(j);
RETURN;
end
ELSE if char = "?" then
begin
dpystr ("
C for command summary, U for Updates, ^O aborts typeout, <CR> to cancel");
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!format1;
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;
procedure change!format;
begin
change!format1;
refresh(top);
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 offline[point[i]] then out(jfn, "O") else out(jfn, " ");
if archived[point[i]] then out(jfn, "A") else
if archive!requested[point[i]] then out(jfn, "R") else
out(jfn, " ");
IF invisible[POINT[i]] THEN OUT(jfn, "I") else out(jfn, " ");
IF deleted[point[i]] THEN OUT(jfn, "D") ELSE OUT(jfn, " ");
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!count > 0 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 _ 0;
end;
endc
outstr ("
F I N I S H E D " & restart & "
CONTINUE to start over
" );
quick!code haltf end;
jfn _ gtjfnx (restart, '101127777775, '377777377777,
NULL, null, "*", "*", null, NULL,
0, '10000000000);
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] save!mark;
["!"] bang;
["!" + '200] meta!bang;
[" "] ["N" - '100] ['12] prompt(cy + 1);
["H" - '100] ["P" - '100] ["^"] prompt(cy - 1);
["M" - '100 + '200] ["J" - '100 + '200] prompt(20);
["<" + '200] first!file;
[">" + '200] last!file;
["H" - '100 + '200] ["^" + '200] prompt(1);
["V" - '100] ["+"] next!window;
["V" + '200] ["-"] previous!window;
["L" - '100] ["N" + '200] refresh(top);
["N"] refer(true);
["C"] change!format;
["D" - '100] then!previous(delet1);
["D"] then!next(delet1);
["D" + '200] do!region(delet1);
["I"] then!stay(vanis1);
["I" + '200] do!region(vanis1);
["V"] then!stay(visib1);
["V" + '200] do!region(visib1);
["U" - '100] then!previous(undel1);
["U"] then!next(undel1);
["U" + '200] do!region(undel1);
["A" - '100] then!previous(arch1);
["A"] then!next(arch1);
["A" + '200] do!region(arch1);
["R" - '100] then!previous(rest1);
["R"] then!next(rest1);
["R" + '200] do!region(rest1);
ifc not sri!switch thenc
["K"] then!next(kill1);
["K" + '200] do!region(kill1);
endc
["L"] then!stay(list);
["E"] then!stay(tv);
["T"] then!stay(type);
["S"] skip;
["O"] order;
["P"] dump;
["X"] exec;
["M"] set!mask;
["H"] ["?"] help;
["F"] ["Q"] finish;
ELSE beep
END;
end "while";
end;
end "dired"