<> <> <> DIRECTORY Commander, CommandTool, CommandToolLookup USING [LOR, LORA, WithRulesProc], FS, IO, Process, Rope, RopeList; CommandToolLookupImpl: CEDAR PROGRAM IMPORTS Commander, CommandTool, FS, IO, Process, Rope, RopeList EXPORTS CommandToolLookup = BEGIN OPEN CommandToolLookup; ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; DoLookup: PUBLIC PROC [cmd: Commander.Handle, arg: ROPE] RETURNS [paths: LOR _ NIL, procData: Commander.CommandProcHandle _ NIL] = { DoSearch: PROC [arg: ROPE, exact: BOOL] RETURNS [merged: LOR _ NIL, procData: Commander.CommandProcHandle _ NIL] = { cmdPaths: LOR _ NIL; loadPaths: LOR _ NIL; cmPaths: LOR _ NIL; Process.CheckForAbort[]; [cmdPaths, procData] _ FindMatchingCommands[root: arg, requireExact: exact, searchRules: searchRules]; merged _ RemoveDuplicateShorts[cmdPaths, NIL]; IF exact AND merged # NIL AND merged.rest = NIL THEN RETURN [LIST[merged.first], procData]; IF merged # NIL AND merged.rest # NIL THEN RETURN [merged, procData]; Process.CheckForAbort[]; loadPaths _ FindMatchingFiles[root: arg, defaultExtension: ".load", requireExact: exact, searchRules: searchRules]; merged _ RemoveDuplicateShorts[merged, loadPaths]; IF exact AND merged # NIL AND merged.rest = NIL THEN RETURN [LIST[merged.first], NIL]; Process.CheckForAbort[]; cmPaths _ FindMatchingFiles[root: arg, defaultExtension: ".cm", requireExact: exact, searchRules: searchRules]; merged _ RemoveDuplicateShorts[merged, cmPaths]; IF exact AND merged # NIL AND merged.rest = NIL THEN RETURN [LIST[merged.first], NIL]; }; searchRules: REF _ MaybeAddWorkingDir[CommandTool.GetProp[cmd, $SearchRules]]; <> [paths, procData] _ DoSearch[arg, TRUE]; IF paths = NIL THEN <> [paths, procData] _ DoSearch[arg, FALSE]; }; FindMatchingFiles: PUBLIC PROC [root: ROPE, defaultExtension: ROPE, requireExact: BOOL _ TRUE, searchRules: REF ANY] RETURNS [paths: LOR _ NIL] = { eachRule: WithRulesProc = { <<[rule: ROPE] RETURNS [stop: BOOL _ FALSE]>> pat: ROPE _ FS.ExpandName[name: pattern, wDir: rule ! FS.Error => GO TO zilch; ].fullFName; angles _ CountAngles[pat]; FS.EnumerateForNames[pattern: pat, proc: eachName ! FS.Error => GO TO zilch; ]; EXITS zilch => {}; }; eachName: FS.NameProc = { <<[fullFName: ROPE] RETURNS [continue: BOOL]>> IF angles = CountAngles[fullFName] THEN { new: LOR = LIST[fullFName]; IF pathsTail = NIL THEN paths _ new ELSE pathsTail.rest _ new; pathsTail _ new; }; RETURN [TRUE]; }; pattern: ROPE _ root; len: INT _ Rope.Length[pattern]; bang, dot, dir, star: INT _ len; pathsTail: LOR _ NIL; local: BOOL _ TRUE; angles: NAT _ 0; <> FOR pos: INT IN [0..len) DO SELECT Rope.Fetch[pattern, pos] FROM '! => bang _ pos; '. => dot _ pos; '/ => IF pos = 0 THEN local _ FALSE ELSE dir _ pos; '> => dir _ pos; '* => star _ pos; '[ => IF pos = 0 THEN local _ FALSE; ENDCASE; ENDLOOP; IF dir # len AND dot < dir THEN dot _ len; IF star = len AND NOT requireExact AND bang = len THEN { <> pattern _ Rope.Concat[pattern, "*"]; }; IF Rope.Length[defaultExtension] # 0 THEN { <> IF bang = dot THEN { <> pattern _ Rope.Concat[pattern, defaultExtension]; }; }; IF bang = len THEN { <> pattern _ Rope.Concat[pattern, "!H"]; }; IF local AND searchRules # NIL THEN { <> searchRules _ MaybeAddWorkingDir[searchRules]; [] _ DoWithRules[searchRules, eachRule]; } ELSE [] _ eachRule[pattern]; IF star = len AND requireExact AND paths # NIL THEN <> paths.rest _ NIL; }; FindMatchingCommands: PUBLIC PROC [root: ROPE, requireExact: BOOL, searchRules: REF] RETURNS [paths: LOR _ NIL, data: Commander.CommandProcHandle _ NIL] = { eachRule: WithRulesProc = { <<[rule: ROPE] RETURNS [stop: BOOL _ FALSE]>> eachCommand: Commander.EnumerateAction = { <<[key: ROPE, procData: Commander.CommandProcHandle] RETURNS [stop: BOOL _ FALSE]>> keyLen: INT _ Rope.Length[key]; ruleRun: INT _ Rope.Run[rule, 0, key, 0, FALSE]; IF rule = NIL OR (ruleRun = ruleLen AND Rope.SkipTo[key, ruleRun, "/"] = keyLen) THEN { rootRun: INT _ Rope.Run[root, 0, key, ruleRun, FALSE]; keyLen: INT _ Rope.Length[key]; SELECT TRUE FROM rootRun = rootLen AND rootRun = keyLen-ruleRun => { <> paths _ pathsTail _ LIST[key]; data _ procData; RETURN [TRUE]; }; requireExact => { <> }; starPos = rootRun => { <> IF starPos+1 >= rootLen THEN <> addName[key, procData] ELSE { <> short: ROPE _ Rope.Substr[key, ruleRun]; IF Rope.Match[root, short, FALSE] THEN addName[key, procData]; }; }; ENDCASE; }; }; ruleLen: INT _ Rope.Length[rule]; IF requireExact THEN { <> fullName: ROPE _ Rope.Concat[rule, root]; data _ Commander.Lookup[fullName]; IF data # NIL THEN {paths _ LIST[fullName]; RETURN [stop: TRUE]}; RETURN [FALSE]; }; IF Commander.Enumerate[eachCommand].key # NIL THEN RETURN [TRUE]; }; rootLen: INT _ Rope.Length[root]; starPos: INT _ Rope.SkipTo[root, 0, "*"]; addName: PROC [name: ROPE, procData: Commander.CommandProcHandle] = { new: LOR _ LIST[name]; IF pathsTail = NIL THEN {paths _ new; data _ procData} ELSE {pathsTail.rest _ new; data _ NIL}; pathsTail _ new; }; pathsTail: LOR _ NIL; IF Rope.Match["/*", root] OR searchRules = NIL THEN [] _ eachRule[NIL] ELSE { searchRules _ MaybeAddWorkingDir[searchRules]; [] _ DoWithRules[searchRules, eachRule]; }; paths _ RopeList.Sort[paths, RopeList.IgnoreCase]; }; DoWithRules: PUBLIC PROC [rules: REF, inner: WithRulesProc] RETURNS [stop: BOOL _ FALSE] = { WITH rules SELECT FROM lora: LORA => WHILE lora # NIL DO IF DoWithRules[lora.first, inner] THEN RETURN [TRUE]; lora _ lora.rest; ENDLOOP; lor: LOR => WHILE lor # NIL DO IF inner[lor.first] THEN RETURN; lor _ lor.rest; ENDLOOP; rope: ROPE => RETURN [inner[rope]]; ENDCASE; }; ShowAmbiguous: PUBLIC PROC [out: STREAM, list: LOR] = { IO.PutRope[out, "{Ambiguous:\n"]; FOR each: LOR _ list, each.rest WHILE each # NIL DO IO.PutF1[out, " %g\n", [rope[each.first]] ]; ENDLOOP; IO.PutRope[out, " }\n"]; }; MaybeAddWorkingDir: PROC [rules: REF] RETURNS [REF] = { <> wDir: ROPE _ CommandTool.CurrentWorkingDirectory[]; checkRule: WithRulesProc = { <<[rule: ROPE] RETURNS [stop: BOOL _ FALSE]>> IF Rope.Equal[rule, wDir, FALSE] THEN RETURN [TRUE]; }; IF rules = NIL THEN RETURN [LIST[wDir]]; IF NOT DoWithRules[rules, checkRule] THEN { <> newList: LIST OF REF ANY _ LIST[wDir, rules]; RETURN [newList]; }; RETURN [rules]; }; RemoveDuplicateShorts: PROC [list: LOR, tail: LOR] RETURNS [LOR] = { list _ RopeList.Append[list, tail]; FOR each: LOR _ list, each.rest WHILE each # NIL DO lag: LOR _ each; eachStart, eachLen: INT; IF each.rest = NIL THEN EXIT; [eachStart, eachLen] _ FindShortPart[lag.first]; FOR other: LOR _ each.rest, other.rest WHILE other # NIL DO otherStart, otherLen: INT; [otherStart, otherLen] _ FindShortPart[other.first]; IF eachLen = otherLen THEN IF Rope.Run[each.first, eachStart, other.first, otherStart, FALSE] >= otherLen THEN { <> lag.rest _ other.rest; LOOP; }; lag _ other; ENDLOOP; ENDLOOP; RETURN [list]; }; FindShortPart: PROC [name: ROPE] RETURNS [start: INT _ 0, len: INT _ 0] = { end: INT _ Rope.Length[name]; start _ end; WHILE start > 0 DO SELECT Rope.Fetch[name, start _ start - 1] FROM '/, '>, '] => {start _ start + 1; EXIT}; '. => end _ start; ENDCASE; ENDLOOP; len _ end - start; }; CountAngles: PROC [name: ROPE] RETURNS [count: NAT _ 0] = { inner: Rope.ActionType = { <<[c: CHAR] RETURNS [quit: BOOL _ FALSE]>> IF c = '> THEN count _ count + 1; }; [] _ Rope.Map[base: name, action: inner] }; TestLookupProc: Commander.CommandProc = { <<[cmd: Handle] RETURNS [result: REF _ NIL, msg: ROPE _ NIL]>> <> out: STREAM = cmd.out; ProcessArgument: PROC [arg: ROPE] = { paths: LOR _ DoLookup[cmd, arg].paths; SELECT TRUE FROM paths = NIL => IO.PutF1[out, "Not found: %g\n", [rope[arg]] ]; paths.rest = NIL => IO.PutF1[out, "Found: %g\n", [rope[paths.first]] ]; ENDCASE => ShowAmbiguous[out, paths]; }; argsProcessed: NAT _ 0; <<# of arguments processed>> argv: CommandTool.ArgumentVector _ CommandTool.Parse[cmd: cmd, starExpand: FALSE ! CommandTool.Failed => {msg _ errorMsg; GO TO failed}]; <> FOR i: NAT IN [1..argv.argc) DO <> arg: ROPE = argv[i]; Process.CheckForAbort[]; <> IF Rope.Length[arg] = 0 THEN LOOP; <> ProcessArgument[arg]; <> ENDLOOP; EXITS failed => {result _ $Failure}; }; doc: ROPE = "Tests command lookup."; Commander.Register[ key: "///Commands/Lookup", proc: TestLookupProc, doc: doc, clientData: NIL, interpreted: TRUE ]; END.