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"