XNSFilingPathImpl.mesa
Copyright Ó 1990, 1992 by Xerox Corporation. All rights reserved.
Bill Jackson (bj), May 30, 1990 3:33 pm PDT
DIRECTORY
Ascii USING [NUL, SP, TAB],
Commander USING [CommandProc, Handle, Register],
Convert USING [CardFromRope, Error, RopeFromCard],
IO USING [BreakProc, CharClass, GetTokenRope, PutF, rope, STREAM],
MessageWindow USING [Append],
PFSBackdoor,
PFSNames,
ProcessProps USING [GetProp],
RefText USING [Append, Fetch, Length, ObtainScratch, ReleaseScratch],
Rope USING [Concat, Fetch, FromRefText, IsEmpty, Length, ROPE, Substr],
RuntimeError USING [ ],
XNSFilingNames USING [ ],
XNSFilingOps USING [Op],
XNSFilingPrivate USING [ ];
XNSFilingPathImpl:
CEDAR
MONITOR
IMPORTS Commander, Convert, IO, PFSBackdoor, PFSNames, ProcessProps, RefText, Rope
EXPORTS XNSFilingNames, XNSFilingPrivate
SHARES PFSNames ~ {
ROPE: TYPE ~ Rope.ROPE;
Magic
DebugOut:
PUBLIC
PROC [msg:
ROPE] ~ {
IF ( debugging )
THEN {
cmd: Commander.Handle ~ NARROW[ProcessProps.GetProp[$CommanderHandle]];
out: IO.STREAM ~ IF ( cmd # NIL )
THEN cmd.out ELSE NARROW[ProcessProps.GetProp[$StdOut]];
IF ( out = NIL ) THEN { --MessageWindow.Append[msg, TRUE];-- RETURN };
out.PutF["%g\n", IO.rope[msg] ];
};
};
debugging: BOOL ¬ FALSE;
DebugCmd: Commander.CommandProc ~ {
atom: ATOM ~ NARROW[cmd.procData.clientData];
SELECT atom
FROM
$true => { debugging ¬ TRUE };
$false => { debugging ¬ FALSE };
ENDCASE => { result ¬ $Failure };
};
XNSFilingNames
Unparsed:
TYPE ~
RECORD [ canonicalUnparsing:
ROPE ¬
NIL ];
UnparseName:
PUBLIC
PROC [name: PFSNames.
PATH]
RETURNS [filingName:
ROPE] ~ {
serverComponent: BOOL ¬ TRUE;
cproc: PFSNames.ComponentProc ~ {
chunk: ROPE ~ UnparseComponent[comp];
filingName ¬ filingName.Concat[chunk];
IF ( serverComponent )
THEN {
IF ( comp.name.len # 0 ) THEN filingName ¬ filingName.Concat[":"];
serverComponent ¬ FALSE;
}
};
sproc: PFSNames.SeparatorProc ~ {
IF (
NOT serverComponent )
THEN { IF ( separatorPresent ) THEN filingName ¬ filingName.Concat["/"] }
ELSE { IF ( NOT separatorPresent ) THEN serverComponent ¬ FALSE };
};
unparsed: REF Unparsed;
name ¬ PFSNames.NonNIL[name];
unparsed ¬
WITH name.GetUnparsingHint[]
SELECT
FROM
unp: REF Unparsed => unp,
ENDCASE => NIL;
IF ( unparsed # NIL ) THEN RETURN [unparsed.canonicalUnparsing];
name.Map[cproc, sproc];
};
UnparseComponent:
PUBLIC
PROC [component: PFSNames.Component]
RETURNS [r:
ROPE] ~ {
chunk: ROPE ~ component.name.base.Substr[component.name.start, component.name.len];
vers: ROPE ~ UnparseVersion[component.version];
r ¬ Rope.Concat[chunk, vers];
};
UnparseVersion:
PUBLIC
PROC [version: PFSNames.Version]
RETURNS [r:
ROPE] ~ {
HardCase:
PROC
RETURNS [v:
ROPE] ~
INLINE {
numb: ROPE ~ Convert.RopeFromCard[version.version];
v ¬ Rope.Concat["!", numb];
};
r ¬
SELECT version.versionKind
FROM
none => NIL,
lowest => "!-",
highest => "!+",
all => "!*",
numeric => HardCase[],
ENDCASE => NIL;
};
ParseName:
PUBLIC
PROC [name:
ROPE]
RETURNS [parsedName: PFSNames.
PATH] ~ {
Canonical parsing.
absolute, directory: BOOL ¬ FALSE;
comps: LIST OF PFSNames.Component ¬ NIL;
IF ( name.IsEmpty[] ) THEN RETURN [NIL];
IF ( FALSE ) THEN DebugOut[name];
absolute ¬ ( name.Fetch[0] = '/ );
IF ( absolute ) THEN comps ¬ CONS[ [], comps ];
directory ¬ ( name.Fetch[name.Length[]-1] = '/ );
{
ENABLE Error => {
msg: ROPE ~ name.Concat[": syntactically invalid file name"];
PFSBackdoor.ProduceError[invalidNameSyntax, msg];
};
pos: NAT ¬ IF ( absolute ) THEN 1 ELSE 0;
limit: NAT ¬ name.Length[];
firstComponent: BOOL ¬ TRUE;
ScanComponent:
PROC ~ {
nextComp: PFSNames.Component;
base: ROPE; start, len: INT;
[nextComp, pos] ¬ ParseComponent[name, pos];
base ¬ nextComp.name.base; start ¬ nextComp.name.start; len ¬ nextComp.name.len;
SELECT
TRUE
FROM
( NOT firstComponent ) => { NULL };
( absolute ) => { NULL };
( len <= 0 ) => { NULL };
( base.Fetch[start+len.
PRED] = ': ) => {
absolute ¬ TRUE;
nextComp.name.len ¬ len.PRED;
};
ENDCASE => { NULL };
firstComponent ¬ FALSE;
comps ¬ CONS[nextComp, comps];
};
ScanSeparator:
PROC ~ {
IF ( name.Fetch[pos] # '/ ) THEN ERROR Error[];
pos ¬ pos.SUCC;
};
DO
IF ( pos >= limit ) THEN EXIT;
ScanComponent[];
IF ( pos >= limit ) THEN EXIT;
ScanSeparator[];
ENDLOOP;
};
{
unparsed: REF Unparsed ~ NEW[Unparsed ¬ [name]];
parsedName ¬ PFSNames.ConstructName[components: comps, absolute: absolute, directory: directory, reverse: TRUE, unparsed: unparsed];
};
};
ParseComponent:
PUBLIC
PROC [name:
ROPE, first:
NAT ¬ 0]
RETURNS [component: PFSNames.Component ¬ [], next:
NAT] ~ {
limit: NAT ¬ name.Length[];
next ¬ first;
DO
IF ( next >= limit )
THEN {
component.name ¬ [name, first, next-first];
EXIT;
};
SELECT ( name.Fetch[next] )
FROM
'! => {
component.name ¬ [name, first, next-first];
[component.version, next] ¬ ParseVersion[name, next];
EXIT;
};
'/ => {
component.name ¬ [name, first, next-first];
EXIT;
};
ENDCASE => next ¬ next.SUCC;
ENDLOOP;
};
ParseVersion:
PUBLIC
PROC [v:
ROPE, first:
NAT ¬ 0]
RETURNS [version: PFSNames.Version ¬ [none], next:
NAT] ~ {
limit: NAT ¬ v.Length[];
next ¬ first;
IF ( next >= limit ) THEN RETURN;
IF ( v.Fetch[next]#'! ) THEN ERROR Error[];
next ¬ next.SUCC;
SELECT v.Fetch[next]
FROM
IN ['0..'9] => {
vers: ROPE; card: CARD32;
start: NAT ¬ next;
next ¬ next.SUCC;
WHILE ( next < limit ) AND ( v.Fetch[next] IN ['0..'9] ) DO next ¬ next.SUCC ENDLOOP;
vers ¬ v.Substr[start, next-start];
card ¬ Convert.CardFromRope[vers];
version ¬ [numeric, card]; -- next ¬ next;
RETURN;
};
'H, 'h => RETURN[ [highest], next.SUCC ];
'L, 'l => RETURN[ [lowest], next.SUCC ];
'+ => RETURN[ [highest], next.SUCC ];
'- => RETURN[ [lowest], next.SUCC ];
'N, 'n => RETURN[ [next], next.SUCC ];
'* => RETURN[ [all], next.SUCC ];
ENDCASE => NULL;
ERROR Error[];
};
ParseNameFromStream:
PUBLIC
PROC [s:
IO.
STREAM]
RETURNS [name: PFSNames.
PATH] ~ {
A convenient way to read a whitespace-delimited name from a stream;
FileNameProc:
IO.BreakProc ~ {
OPEN Ascii;
class:
IO.CharClass ~
SELECT char
FROM
NUL, SP, TAB => sepr,
ENDCASE => other;
RETURN [class];
};
ropeName: ROPE ¬ IO.GetTokenRope[s, FileNameProc].token;
name ¬ ParseName[ropeName];
};
Filename Utils
RopeForPath:
PROC [path: PFSNames.
PATH]
RETURNS [rope:
ROPE ¬
NIL] ~ {
};
ParseFSName:
PROC [file:
ROPE]
RETURNS [dir:
LIST
OF
ROPE, name:
ROPE, vers: PFSNames.Version] ~ {
dirSeen: BOOL ¬ FALSE;
versR: ROPE ¬ NIL;
stopAt: INT ¬ file.Length[];
FOR i:
INT
DECREASING
IN [0..file.Length[])
DO
c: CHAR ~ file.Fetch[index: i];
SELECT c
FROM
'! => { versR ¬ file.Substr[start: i]; stopAt ¬ i.PRED };
'> => {
IF ( dirSeen )
THEN dir ¬ CONS[file.Substr[start: i.SUCC, len: stopAt.PRED], dir]
ELSE name ¬ file.Substr[start: i.SUCC, len: stopAt - i];
dirSeen ¬ TRUE;
stopAt ¬ i-1;
};
'< => {
dir ¬ CONS[file.Substr[start: i.SUCC, len: stopAt-i], dir];
EXIT; -- this must be the last char
};
ENDCASE => NULL;
ENDLOOP;
vers ¬ [$none];
IF ( versR.Length[] > 1 )
THEN {
rope: ROPE ~ Rope.Substr[base: versR, start: 1];
card: CARD32 ¬ 0;
card ¬ Convert.CardFromRope[rope ! Convert.Error => { CONTINUE }];
IF ( card > 0 ) THEN vers ¬ [$numeric, card];
};
};
ConvertFSNameToXNS:
PUBLIC
PROC [file:
ROPE, op: XNSFilingOps.Op]
RETURNS [name:
ROPE ¬
NIL] ~ {
text: REF TEXT ~ RefText.ObtainScratch[nChars: 200];
AddChar: PROC [c: CHAR] = { text[text.length] ¬ c; text.length ¬ text.length.SUCC };
versionR: ROPE ¬ NIL;
text.length ¬ 0;
FOR i:
INT
IN [0..file.Length[])
DO
c: CHAR ~ file.Fetch[index: i];
SELECT c
FROM
'< => { LOOP }; -- throw the < away.
'> => { AddChar['/] }; -- the XNS server uses / as a file separator
'* => { AddChar[c]; AddChar[c] }; -- kludge to handle *
'! => { versionR ¬ file.Substr[start: i]; EXIT }; -- the whole version including the !
ENDCASE => { AddChar[c] };
ENDLOOP;
name ¬ Rope.FromRefText[s: text];
RefText.ReleaseScratch[t: text];
IF ( versionR #
NIL )
THEN {
SELECT versionR.Length[]
FROM
0 => { versionR ¬ NIL }; -- no version specified
1 => {
the version rope is just a ! so do the 'default'
versionR ¬
SELECT op
FROM
delete => "!-", -- lowest
enumerate => NIL,
enumerateNames => NIL,
rename => "!+", -- highest
retrieve => "!+", -- highest
store => "!+", -- is this right?
ENDCASE => ERROR; -- can't happen
};
2 => {
-- is it H, L or *?
versionR ¬
SELECT versionR.Fetch[1]
FROM
'h, 'H => "!+",
'l, 'L => "!-",
'* => NIL,
ENDCASE => versionR;
};
ENDCASE => NULL;
IF ( versionR # NIL ) THEN name ¬ name.Concat[versionR];
};
};
ConvertPathToFile:
PROC [path:
REF
TEXT, isDir:
BOOL ¬
FALSE]
RETURNS [file:
ROPE ¬
NIL] ~ {
slashSeen: BOOL ¬ FALSE;
state: {name, version} ¬ name;
name: REF TEXT ¬ RefText.ObtainScratch[nChars: 200];
ver: REF TEXT ¬ RefText.ObtainScratch[nChars: 200];
AddChar: PROC [t: REF TEXT, c: CHAR] ~ { t[t.length] ¬ c; t.length ¬ t.length.SUCC };
name.length ¬ 0;
ver.length ¬ 0;
AddChar[name, '<]; -- since the path doesn't have this
FOR i:
INT
IN [0..RefText.Length[path])
DO
c: CHAR ~ RefText.Fetch[path, i];
SELECT c
FROM
'! => { ver.length ¬ 0; state ¬ version };
discard the version information since it is still a subdir
'/ => {
slashSeen ¬ TRUE;
ver.length ¬ 0; -- discard the version information since it is still a subdir
state ¬ name; -- go back to collection characters
AddChar[name, '>]; -- insert FS's notion of what a delineator is
};
'> => {
-- an illegal character
RefText.ReleaseScratch[t: name];
RefText.ReleaseScratch[t: ver];
RETURN;
};
ENDCASE => {
SELECT state
FROM
name => AddChar[name, c];
version => AddChar[ver, c];
ENDCASE => ERROR;
};
ENDLOOP;
IF ( state = version )
THEN {
-- this is the version from the item last on the path
IF ( ( NOT slashSeen ) OR ( isDir ) ) THEN AddChar[name, '>];
AddChar[name, '!]; -- indicate the version
name ¬ RefText.Append[to: name, from: ver]; -- and glue it on
};
file ¬ Rope.FromRefText[s: name];
RefText.ReleaseScratch[t: name];
RefText.ReleaseScratch[t: ver];
};
Commander.Register["XNSFiling.DebugOn", DebugCmd, "start logging", $true];
Commander.Register["XNSFiling.DebugOff", DebugCmd, "stop logging", $false];
}.