-- CommandToolMXCode.mesa
DIRECTORY Atom, CedarProcess, ProcessorFace, Rope, SafeStorage, Scheme, ThisMachine, ViewerTools;
CommandToolMXCode: CEDAR PROGRAM
IMPORTS Atom, CedarProcess, ProcessorFace, SafeStorage, Scheme, ThisMachine, ViewerTools
= BEGIN OPEN Scheme;
  SymbolFromRope: PROC [rope: Rope.ROPE] RETURNS [Symbol] ~ {RETURN[Atom.MakeAtom[rope]]};
  RopeFromSymbol: PROC [Symbol] RETURNS [Rope.ROPE] ~ Atom.GetPName;
  TheSymbol: PROC [a: Any] RETURNS [Scheme.Symbol] = {
    WITH a SELECT FROM
      a: Scheme.Symbol => RETURN [a];
      ENDCASE => Complain[a, "not a Scheme.Symbol"];
    };
  SymbolForPriority: REF ARRAY CedarProcess.Priority OF Symbol = InitSymbolForPriority[];
  InitSymbolForPriority: PROC RETURNS [a: REF ARRAY CedarProcess.Priority OF Symbol] = {
    a _ NEW[ARRAY CedarProcess.Priority OF Symbol];
    a[background] _ $background;
    a[normal] _ $normal;
    a[foreground] _ $foreground;
    a[excited] _ $excited;
    a[realTime] _ Atom.MakeAtom["real-time"];
    };
  ThePriority: PROC [a: Any] RETURNS [CedarProcess.Priority] = {
    FOR k: CedarProcess.Priority IN CedarProcess.Priority DO
      IF a=SymbolForPriority[k] THEN RETURN [k];
      ENDLOOP;
    ERROR Complain[a, "is not a CedarProcess.Priority"];
    };
  CommandToolPrim: PROC [SELF: Primitive, ARG1,ARG2,ARG3: Any, REST: ProperList] RETURNS [result: Any _ unspecified] = {
    POP: PROC RETURNS [a: Any _ undefined] = {
      IF REST#NIL THEN {a _ REST.car; REST _ NARROW[REST.cdr]}};
    DATA: Pair ~ NARROW[SELF.data];
    env: Environment ~ NARROW[DATA.cdr];
    SELECT NAT[NARROW[DATA.car, REF INT]^] FROM
      7 => {
        result _ StringFromRope[ViewerTools.GetSelectionContents[]];
        };
      6 => {
        traceAndSweepP: Any _ ARG1;
        SafeStorage.ReclaimCollectibleObjects[suspendMe: TRUE, traceAndSweep: traceAndSweepP=true];
        };
      5 => {
        RETURN [MakeFixnum[SafeStorage.CurrentByteCount[]]];
        };
      4 => {
        result ¬ ProcessorFace.GetProcessorTypeName[ProcessorFace.GetProcessorType[]];
        };
      3 => {
        result _ StringFromRope[ThisMachine.ProcessorID[$Decimal]];
        };
      2 => {
        namespace: Any _ ARG1;
        result _ StringFromRope[ThisMachine.Address[SELECT namespace FROM $arpa => $Arpa, $xns => $XNS, $pup => $Pup, undefined => NIL, ENDCASE => TheSymbol[namespace]]];
        };
      1 => {
        namespace: Any _ ARG1;
        result _ StringFromRope[ThisMachine.Name[SELECT namespace FROM $arpa => $Arpa, $xns => $XNS, $pup => $Pup, undefined => NIL, ENDCASE => TheSymbol[namespace]]];
        };
      0 => {
        priority: Any _ ARG1;
        result _ SymbolForPriority[CedarProcess.GetPriority[]];
        CedarProcess.SetPriority[ThePriority[priority]];
        };
      ENDCASE => ERROR
    };
    
  CommandToolInit: PROC [env: Environment] = {
    DefinePrimitive[name: "get-selection-contents", nArgs: 0, proc: CommandToolPrim, doc: "() Return the contents of the Tioga selection as a string.", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[7], env]];
    DefinePrimitive[name: "gc", nArgs: 1, proc: CommandToolPrim, doc: "([ trace-and-sweep? ]) call the garbage collector", env: env, optional: 1, dotted: FALSE, data: Cons[MakeFixnum[6], env]];
    DefinePrimitive[name: "bytes-allocated", nArgs: 0, proc: CommandToolPrim, doc: "() number of words allocated since the beginning", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[5], env]];
    DefinePrimitive[name: "this-machine-type", nArgs: 0, proc: CommandToolPrim, doc: "() Returns 'sun3, 'sun4, ...", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[4], env]];
    DefinePrimitive[name: "this-machine-id", nArgs: 0, proc: CommandToolPrim, doc: "() Returns a string like \"1-435-140-188\"", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[3], env]];
    DefinePrimitive[name: "this-machine-address", nArgs: 1, proc: CommandToolPrim, doc: "([ namespace ]) Returns a string; namespace is 'arpa, 'xns, 'pup, ...", env: env, optional: 1, dotted: FALSE, data: Cons[MakeFixnum[2], env]];
    DefinePrimitive[name: "this-machine-name", nArgs: 1, proc: CommandToolPrim, doc: "([ namespace ]) Returns a string; namespace is 'arpa, 'xns, 'pup, ...", env: env, optional: 1, dotted: FALSE, data: Cons[MakeFixnum[1], env]];
    DefinePrimitive[name: "set-priority", nArgs: 1, proc: CommandToolPrim, doc: "(priority) sets priority (background normal foreground excited real-time), returns old priority level", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[0], env]];
    };
    
  ROPE: TYPE ~ Rope.ROPE;
  RegisterInit[CommandToolInit];
END.