Trailing-Edge
-
PDP-10 Archives
-
mit_emacs_170_teco_1220
-
emacs/plan.sai
There are no other files named plan.sai in the archive.
BEGIN "Plan"
COMMENT
Plan,
Version of: September 5th, 1976
Greg Hinchliffe, IMSSS/Stanford
New PLAN file format!
Added editing capabilities!
"Fast" Plan now possible!
;
define crlf = "'15 & '12",
vnum = """2.2""",
vdate = """September 5th, 1976""",
format = "'200200000000",
spa = "1",
lin = "2",
nobrk = "3",
spa!cr = "4",
maxplans = "100",
exit = "quick!code haltf; end";
string dirname, cmd, str, pname, plantext;
string array plans[1:maxplans];
comment Hopefully no one will be wanting more than 100 plans! ;
integer x, y, z, dirnum, numplans, sdesc, brchar, nchan,
pchan, plannum, eof;
external integer !skip!;
integer array fdb[0:'25];
integer array begtm, endtm[1:maxplans];
boolean quickplan;
boolean array shoulddump, backgnd, deleted[1:maxplans];
ifc not declaration (kl) thenc define kl = true endc;
ifc kl thenc
require "
KL Version " message;
integer char;
define RSCAN = "'104000000500";
require "sai:texti.hdr" source!file;
endc;
simple string procedure raise (string what);
begin "raise"
string nwhat; integer char; nwhat _ null;
do
begin "chop"
char _ lop(what);
if char > '140 and char < '173 then char _ char - '40;
nwhat _ nwhat & char;
end "chop" until not length(what);
return(nwhat);
end "raise";
simple integer procedure relative (string relstr);
begin "relative"
integer word, days, currd;
string date;
currd _ idtim(odtim(-1,0));
days _ cvd(scan(relstr, spa, brchar));
if days < 0 then return(-1);
if brchar = " " then
word _ idtim(odtim((currd lsh -18 + days) lsh 18 + (currd land '777777),'044400000000) & " " & relstr)
else
begin "midnight"
date _ odtim((currd lsh -18 + days) lsh 18 + (currd land '777777),'044400000000);
date _ date & " 0000";
word _ idtim(date);
end "midnight";
return(word);
end "relative";
simple integer procedure gettime (string desc; boolean crnow);
begin "gettime"
integer time;
while true
do
begin "getloop"
outstr (desc);
str _ intty;
if str = "?" then
begin "help"
outstr ("
The following are examples of valid dates and times:
Dates:
17-APR-70
APR-17-70
APR 17 70
APRIL 17, 1970
17 APRIL 70
17/5/1970
5/17/70
Times:
1:12:13
1234
16:30 (4:30PM)
1630
1234:56
1:56AM
1:56-PST
1200NOON
12:00:00AM (midnight)
11:59:59AM-PST (late morning)
12:00:01AM (early morning)
If only a time is input, the current date is assumed.
Relative formats:
+1 1355 To start/expire the
next day at 1:55pm
+0 To start/expire at
midnight today.
(Note: The ""+"" sign must preceed all relative
commands, and ""-"" is illegal).
");
continue "getloop";
end "help"
else
if not length(str) then
begin "now"
if crnow then
begin "ok"
time _ idtim(odtim(-1,0));
!skip! _ false;
end "ok";
end "now"
else
if str = "+" then
begin "getrelative"
time _ relative(str[2 to INF]);
if time = -1 then continue "getloop";
end "getrelative"
else
begin "checkinput"
time _ idtim(str);
if !skip! then
time _ idtim(odtim(-1,'000400000000) & " " & str);
end "checkinput";
if not !skip! then done "getloop";
end "getloop";
return(time);
end "gettime";
simple boolean procedure confirm;
begin "confirm"
outstr ("[Confirm] ");
z _ inchrw;
if z = '37 or z = '15 then return(true) else
begin "nope"
outstr ('11 & "XXX" & crlf);
return(false);
end "nope";
end "confirm";
simple procedure renamefiles (reference integer oldchan, newchan;
integer count);
begin "renamefiles"
integer len;
outstr ("Plan file contains " & cvs(count) & (if
count > 1 then " plans" else " plan"));
gtfdb(newchan,fdb);
len _ fdb['12];
outstr (" (" & cvs(len) & " words)");
str _ jfns(oldchan,0); cfile(oldchan); oldchan _ gtjfn(str, 0);
str _ jfns(newchan, 0); cfile(newchan); newchan _ gtjfn(str, 0);
rnamf(newchan,oldchan);
end "renamefiles";
procedure dumparrays;
begin "dumparrays"
integer ncount, swd, wd;
integer array pnums, len, strtchar[1:maxplans];
ncount _ 0;
pchan _ gtjfn("<" & dirname & ">Plan.Txt",0);
if !skip! then
begin "gtjfn error"
pchan _ openfile("<" & dirname & ">Plan.Txt","WOED");
if !skip! then
begin "new!file?"
pchan _ openfile("<" & dirname & ">Plan.Txt","WNE");
if !skip! then
begin "real!trouble"
outstr ("Cannot make a plan file for you!");
exit;
end "real!trouble";
end "new!file?"
else undelete(pchan);
end "gtjfn error"
else
begin "normal"
chfdb(pchan, 4, '777777, '777752); rljfn(pchan);
pchan _ openfile("<" & dirname & ">Plan.Txt","WOE");
if !skip! then
begin "openf error"
outstr ("Cannot OPENFILE your plan file!");
exit;
end "openf error";
end "normal";
if numplans > 0 then
begin "okdump"
nchan _ openfile("<" & dirname & ">Plan.Tmp","WT");
for x _ 1 step 1 until numplans
do
if shoulddump[x] then
begin "dumpit"
pnums[ncount _ ncount + 1] _ x;
len[ncount] _ length(plans[x]); strtchar[ncount] _ rchptr(nchan);
out (nchan, plans[x]);
end "dumpit";
swd _ rchptr(nchan) / 5 + 1;
swdptr(nchan, swd);
chfdb(nchan, '24, '777777777777, swd lsh 18 + ncount);
if ncount > 0 then
begin "gotplans"
for x _ 1 step 1 until ncount
do
begin "changedesc"
wd _ ((if backgnd[pnums[x]] then '400000000000 else 0) +
(strtchar[x] lsh 18)) + len[x];
wordout(nchan, wd);
wordout(nchan, begtm[pnums[x]]);
wordout(nchan, endtm[pnums[x]]);
end "changedesc";
renamefiles(pchan, nchan, ncount);
chfdb(pchan, 4, '777777, '525252);
end "gotplans"
else
begin "gotnoplans"
outstr ("No plans; deleting plan file");
delf(nchan); delf(pchan);
cfile(nchan); cfile(pchan);
end "gotnoplans";
end "okdump"
else
begin "noplans"
outstr ("No plans; deleting plan file");
delf(pchan);
cfile(pchan);
end "noplans";
end "dumparrays";
simple procedure cleanup;
begin "cleanup"
integer time;
time _ idtim(odtim(-1,0));
arrclr(shoulddump,true);
for x _ 1 step 1 until numplans do
if deleted[x] or endtm[x] leq time then shoulddump[x] _ false;
dumparrays;
end "cleanup";
simple boolean procedure range(integer pnum);
return(0 < pnum leq numplans);
simple procedure plantype (integer pnum);
begin "plantype"
str _ plans[pnum];
pname _ scan(str, lin, brchar);
outstr (crlf & "Plan number " & cvs(pnum) & " (" & pname &
"):" & crlf & crlf & "Start date: " & odtim(begtm[pnum], format)
& crlf & "Expire date: " & odtim(endtm[pnum], format) & crlf &
(if backgnd[pnum] then "[Background]" & crlf else null) & crlf &
str & crlf);
end "plantype";
simple procedure listheaders (boolean notdeleted);
begin "listheaders"
for x _ 1 step 1 until numplans
do
if (notdeleted and not deleted[x]) or (not notdeleted and deleted[x]) then
begin "listplans"
str _ plans[x];
pname _ scan(str, lin, brchar);
outstr (cvs(x) & (if backgnd[x] then " [B]" else null) &
'11 & odtim(begtm[x], format) & " " & odtim(endtm[x], format)
& " " & pname & crlf);
end "listplans";
end "listheaders";
simple procedure cdates (integer pnum);
begin "cdates"
outstr (crlf & "Start date: " & odtim(begtm[pnum], format) & ", Change ");
if confirm then begtm[pnum] _ gettime("Start time (CR for now): ", true);
outstr (crlf & "Expire date: " & odtim(endtm[pnum], format) & ", Change ");
if confirm then endtm[pnum] _ gettime("Expire time: ",false);
end "cdates";
simple string procedure lastline;
begin "lastline"
string copy, lastlin;
copy _ plantext;
while copy do lastlin _ scan(copy,lin,brchar);
if brchar = '12 then lastlin _ lastlin & crlf;
return (lastlin);
end "lastline";
simple string procedure lastword;
begin "lastword"
string copy, lastwd;
copy _ plantext;
while copy do lastwd _ scan(copy,spa!cr,brchar);
return(" " & lastwd);
end "lastword";
simple procedure deletechar;
begin "deletechar"
integer char;
char _ plantext[INF to INF];
COMMENT: Assume that there is a CR ('15) before every LF ('12);
if char = '12 then
begin "print!last!line"
plantext _ plantext[1 to INF-2];
ifc kl thenc outstr ("\" & crlf); elsec
quick!code movei 1, '100; JSYS '625; JFCL; JFCL; JFCL; JFCL; end;
endc;
outstr (lastline);
end "print!last!line"
else
begin "normal"
plantext _ plantext[1 to INF-1];
ifc kl thenc outstr ("\" & char); elsec
quick!code movei 1, '100; JSYS '625; JFCL; JFCL; JFCL; JFCL; end;
endc;
end "normal";
end "deletechar";
simple procedure deleteline;
begin "deleteline"
if not equ(plantext[INF-2 to INF],'15 & '12) then
plantext _ plantext[1 to INF-length(lastline)];
outstr ("##" & crlf);
end "deleteline";
simple procedure deleteword;
begin "deleteword"
plantext _ plantext[1 to INF-length(lastword)];
outstr ("_");
end "deleteword";
simple procedure retypeline;
if not equ(plantext[INF-1 to INF],'15 & '12) then
outstr (crlf & lastline);
simple procedure retypeplan;
outstr (crlf & crlf & "Plan (? for help):" & crlf & plantext);
simple procedure insertfile;
begin "insertfile"
integer chan, oac2, oac3;
outstr (crlf & "(File Name: ");
start!code
movei 1, '100;
RFCOC;
movem 2, oac2;
movem 3, oac3;
trz 2, '141400;
trz 3, '601400;
SFCOC;
end;
chan _ openfile(null,"ROCE");
if !skip! then outstr(" ?)")
else
begin "inputfile"
setinput(chan,200,brchar,eof);
outstr (" ...");
do plantext _ plantext & input(chan,lin) & crlf
until eof;
cfile(chan);
outstr ("DONE)");
end "inputfile";
start!code
movei 1, '100;
move 2, oac2;
move 3, oac3;
SFCOC;
end;
outstr (crlf);
end "insertfile";
simple procedure startover;
begin "startover"
plantext _ null;
retypeplan;
end "startover";
simple procedure addplan (boolean quick);
begin "addplan"
integer char, oac2, oac3;
plantext _ null;
numplans _ numplans + 1;
if quick then begtm[numplans] _ idtim(odtim(-1,0)) else
begtm[numplans] _ gettime("Start time (CR for now): ",true);
endtm[numplans] _ gettime("Expire time: ",false);
outstr ("Plan name (CR for none): ");
pname _ intty;
if not length(pname) then pname _ "---";
if quick then backgnd[numplans] _ false else
begin "backgnd!flag"
outstr ("Background (Y or N): ");
backgnd[numplans] _ raise(inchrw) = "Y";
end "backgnd!flag";
plans[numplans] _ pname & crlf;
ifc kl thenc
outstr (crlf & crlf & "Plan, terminate with ^Z:" & crlf);
plantext _ texti(null,null,'32,2000)[1 to inf-1];
elsec
outstr (crlf & crlf & "Plan (? for help):" & crlf);
start!code
movei 1, '100;
RFCOC;
movem 2, oac2;
movem 3, oac3;
tlz 2, '150000;
tlz 3, '740360;
SFCOC;
end;
do
begin "enter"
quick!code PBIN; movem 1, char; end;
char _ char land '177;
if char = "?" and not length(plantext) then
outstr ("
Type text of plan, ending with ^Z (control-Z).
Control characters available for editing:
<DEL> Delete character
^A Same as <DEL>
^B Insert file
^N Start over
^R Retype current line
^S Retype text of entire plan
^W Delete one word
" & ifc kl thenc "^U" elsec "^X" endc
& " Scratch current line
It is possible to delete beyond the current line you are typing."
& ifc not kl thenc "
<LF> will be treated as a CRLF (CARRIAGE RETURN and LINEFEED).
" elsec crlf endc
& "
Plan (? for help):
")
else
if char = '177 then deletechar
else
if char < '37 then
case char of
ifc kl thenc
begin "case!chars"
['1] deletechar;
['2] insertfile;
['12] plantext _ plantext & '12;
['16] startover;
['22] retypeline;
['23] retypeplan;
['25] deleteline;
['27] deleteword;
['32] done "enter";
else outchr('7)
end "case!chars"
elsec
begin "case!chars"
['1] deletechar;
['2] insertfile;
['12] plantext _ plantext & '15 & '12;
['16] startover;
['22] retypeline;
['23] retypeplan;
['27] deleteword;
['30] deleteline;
['32] done "enter";
else outchr('7)
end "case!chars"
endc
else
plantext _ plantext & (if char = '37 then '15 & '12 else char);
end "enter" until false;
endc;
plans[numplans] _ plans[numplans] & plantext &
(if plantext[INF to INF] neq '12 then crlf else null);
ifc not kl thenc
start!code
movei 1, '100;
move 2, oac2;
move 3, oac3;
SFCOC;
end;
endc;
outstr (crlf);
end "addplan";
simple procedure quickie;
begin "quickie"
addplan(true);
outstr ("Finishing: ");
arrclr(shoulddump,true);
dumparrays;
exit;
end "quickie";
setbreak (lin, '12, '15, "INS");
setbreak (spa, '40, null, "INS");
setbreak (spa!cr, '40 & '15, null, "INS");
setbreak (nobrk, null, null, "INS");
gjinf(dirnum, 0, 0);
dirname _ dirst(dirnum);
ifc kl thenc
quickplan _ false;
quick!code SETZ 1, ; RSCAN; TDN; end;
while (char _ inchrs) > '37 do if char = '40 then quickplan _ true;
elsec
bkjfn('101);
quickplan _ inchrs = '40;
endc;
if quickplan then outstr (ifc kl thenc crlf elsec crlf & crlf endc & "Speedy PLAN,") else
outstr (crlf & "PLAN,");
outstr (crlf & " Version " & vnum & " of " & vdate & crlf & crlf);
pchan _ openfile("<" & dirname & ">Plan.Txt","ROE");
if not !skip! then
begin "read!in"
gtfdb(pchan, fdb);
numplans _ fdb['24] land '777777;
sdesc _ fdb['24] lsh -18 land '777777;
swdptr(pchan, sdesc);
if numplans > 0 then
for x _ 1 step 1 until numplans
do
begin "load stuff"
integer begtime, endtime, schar, len, wpoint;
schar _ wordin(pchan);
len _ schar land '777777;
backgnd[x] _ schar land '400000000000;
schar _ schar lsh -18 land '377777;
begtm[x] _ wordin(pchan); endtm[x] _ wordin(pchan);
wpoint _ rwdptr(pchan);
schptr(pchan, schar);
setinput(pchan, len, brchar, eof);
plans[x] _ input(pchan, nobrk);
swdptr(pchan, wpoint);
end "load stuff";
chfdb(pchan, 4, '777777, '525252);
cfile(pchan);
end "read!in";
if quickplan then quickie;
while true
do
begin "cloop"
outstr (crlf & ">");
cmd _ raise(inchrw);
if cmd = "?" then
outstr (crlf & "Char Action" & crlf & "
C Create a New Plan
D Delete Plan Number n
U Undelete Plan Number n
T Type Plan Number n
L List All Plan Headers
S Show List of Deleted Plan Headers
N New Dates for Plan Number n
B Background Toggle for Plan Number n
Z Zap Plan File (Delete and exit)
Q Quit (Do not expunge deleted and expired plans)
E Exit (Expunge deleted and expired plans)" & crlf & crlf)
else
if cmd = "D" then
begin "deleteplan"
outstr ("elete plan number: ");
plannum _ cvd(intty);
if not range(plannum) then outstr (" No such plan") else
deleted[plannum] _ true;
end "deleteplan"
else
if cmd = "U" then
begin "undeleteplan"
outstr ("ndelete plan number: ");
plannum _ cvd(intty);
if not range(plannum) then outstr (" No such plan") else
deleted[plannum] _ false;
end "undeleteplan"
else
if cmd = "T" then
begin "typeplan"
outstr ("ype plan number: ");
plannum _ cvd(intty);
if range(plannum) then
begin "maybe!ok"
if deleted[plannum] then outstr (" No such plan")
else
plantype(plannum);
end "maybe!ok"
else outstr (" No such plan");
end "typeplan"
else
if cmd = "L" then
begin "listing"
outstr ("ist plan headers" & crlf & crlf);
if numplans neq 0 then listheaders(true);
end "listing"
else
if cmd = "S" then
begin "showdeleted"
outstr ("how deleted plan headers" & crlf & crlf);
if numplans neq 0 then listheaders(false);
end "showdeleted"
else
if cmd = "N" then
begin "changedates"
outstr ("ew dates for plan number: ");
plannum _ cvd(intty);
if range(plannum) then
begin "maybe!ok"
if deleted[plannum] then outstr (" No such plan")
else
cdates(plannum);
end "maybe!ok"
else outstr (" No such plan");
end "changedates"
else
if cmd = "B" then
begin "backgnd toggle"
outstr ("ackground toggle for plan number: ");
plannum _ cvd(intty);
if range(plannum) then
begin "maybe!ok"
if deleted[plannum] then outstr (" No such plan")
else
backgnd[plannum] _ not backgnd[plannum];
end "maybe!ok"
else outstr (" No such plan");
end "backgnd toggle"
else
if cmd = "C" then
begin "create"
outstr ("reate a new plan" & crlf & crlf);
addplan(false);
end "create"
else
if cmd = "Z" then
begin "zap!plan!file"
outstr ("ap Plan File ");
if confirm then
begin "zap"
pchan _ gtjfn("<" & dirname & ">Plan.Txt",0);
if !skip! then
begin "trouble"
if !skip! = '600104 then
outstr ("No plan file to delete")
else
outstr ("Problems with your plan file, cannot delete!")
end "trouble"
else
begin "delete"
chfdb(pchan,4,'777777,'777752);
delf(pchan); rljfn(pchan);
outstr ("Plan file deleted");
end "delete";
exit;
end "zap";
end "zap!plan!file"
else
if cmd = "Q" then
begin "quit time"
outstr ("uit ");
if confirm then
begin "quitfini"
outstr ("Finishing: ");
arrclr(shoulddump,true);
dumparrays;
exit;
end "quitfini";
end "quit time"
else
if cmd = "E" then
begin "exit time"
outstr ("xit ");
if confirm then
begin "exitfini"
outstr ("Updating: ");
cleanup;
exit;
end "exitfini";
end "exit time";
end "cloop";
END "Plan"