DIRECTORY Ascii, Basics, Buttons, Commander USING [CommandProc, Register], CommandTool, Containers USING [ChildXBound, ChildYBound, Container, Create], FS, IO, MessageWindow, RefText, Rope, Rules USING [Create, Rule], OldSortDirDefs, TypeScript, VFonts, ViewerClasses USING [Viewer, ViewerClassRec], ViewerIO USING [CreateViewerStreams], ViewerOps USING [PaintViewer], ViewerTools USING [GetContents, MakeNewTextViewer, SetSelection]; OldSortDir: CEDAR PROGRAM IMPORTS Buttons, Commander, CommandTool, Containers, FS, IO, MessageWindow, RefText, Rope, Rules, TypeScript, VFonts, ViewerIO, ViewerOps, ViewerTools = BEGIN OPEN OldSortDirDefs; entryHeight: CARDINAL = 15; -- how tall to make each line of items entryVSpace: CARDINAL = 8; -- vertical leading space between lines entryHSpace: CARDINAL = 10; -- horizontal space between items in a line ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; dash: CHAR = Ascii.ControlV; PromptRec: TYPE = RECORD [ handle: Handle, viewer: ViewerClasses.Viewer _ NIL]; PromptHandle: TYPE = REF PromptRec; MakeTool: Commander.CommandProc = BEGIN rule: Rules.Rule; my: Handle _ NEW[MyRec]; my.outer _ Containers.Create[[-- construct the outer container name: "Directory Sorter", -- name displayed in the caption iconic: TRUE, -- so tool will be iconic (small) when first created column: left, -- initially in the left column scrollable: FALSE ]]; -- inhibit user from scrolling contents MakeCommands[my]; -- build each (sub)viewer in turn rule _ Rules.Create [[parent: my.outer, wy: my.height, ww: my.outer.cw, wh: 2]]; Containers.ChildXBound[my.outer, rule]; my.height _ my.height + entryHeight + 2; -- interline spacing MakeTypescript[my]; ViewerOps.PaintViewer[my.outer, all]; -- reflect above change END; MakeTypescript: PROC [handle: Handle] = BEGIN handle.height _ handle.height + entryVSpace; -- space down from the top of the viewer handle.ts _ TypeScript.Create[ info: [name: "SortDir.ts", wy: handle.height, parent: handle.outer, border: FALSE ]]; [handle.tsIn, handle.tsOut] _ ViewerIO.CreateViewerStreams [ name: "SortDir.ts", viewer: handle.ts, backingFile: "SortDir.ts", editedStream: FALSE]; Containers.ChildXBound[handle.outer, handle.ts]; Containers.ChildYBound[handle.outer, handle.ts]; END; MakeCommands: PROC [handle: Handle] = BEGIN initialData: Rope.ROPE = NIL; wx: INT _ 0; NewLine: PROC = {handle.height _ handle.height + entryHeight + entryVSpace; wx _ 0}; LabeledItem: PROC [label: ROPE, width: INT, data: ROPE _ NIL] RETURNS [v: ViewerClasses.Viewer] = { ph: PromptHandle _ NEW [PromptRec _ [handle: handle]]; t: Buttons.Button _ Buttons.Create[ info: [ name: Rope.Concat[label, ":"], wy: handle.height, wh: entryHeight, -- specify rather than defaulting so line is uniform wx: wx, parent: handle.outer, border: FALSE ], proc: Prompt, clientData: ph]; -- this will be passed to our button proc wx _ wx + t.ww + entryHSpace; v _ ViewerTools.MakeNewTextViewer[ [ parent: handle.outer, wx: wx, wy: handle.height, ww: width*VFonts.CharWidth['0], wh: entryHeight, data: data, scrollable: FALSE, border: FALSE]]; ph.viewer _ v; wx _ wx + v.ww + entryHSpace}; Bool: PROC [label: ROPE, initial: BOOL] RETURNS [flag: REF BOOL] = { t: Buttons.Button; flag _ NEW[BOOL _ initial]; t _ Buttons.Create[ info: [ name: label, wx: wx, wy: handle.height, wh: entryHeight, -- specify rather than defaulting so line is uniform parent: handle.outer, border: TRUE ], proc: ToggleBool, clientData: flag]; -- this will be passed to our button proc Buttons.SetDisplayStyle[ button: t, style: IF initial THEN $WhiteOnBlack ELSE $BlackOnWhite, paint: FALSE]; wx _ wx + t.ww + entryHSpace}; Cmd: PROC [label: ROPE, proc: Buttons.ButtonProc] = { t: Buttons.Button _ Buttons.Create[ info: [ name: label, wx: wx, wy: handle.height, wh: entryHeight, -- specify rather than defaulting so line is uniform parent: handle.outer, border: TRUE ], proc: proc, clientData: handle]; -- this will be passed to our button proc wx _ wx + t.ww + entryHSpace}; NewLine[]; Cmd["Sort", DoIt]; handle.zip _ Bool["zip", FALSE]; NewLine[]; handle.cmd.workingDir _ LabeledItem["working directory", 50, CommandTool.CurrentWorkingDirectory[]]; NewLine[]; handle.cmd.inputFile _ LabeledItem["input", 50]; NewLine[]; handle.cmd.outputFile _ LabeledItem["output", 50]; NewLine[]; END; ToggleBool: Buttons.ButtonProc = { switch: REF BOOL _ NARROW [clientData]; switch^ _ ~switch^; Buttons.SetDisplayStyle[ button: NARROW[parent], style: IF switch^ THEN $WhiteOnBlack ELSE $BlackOnWhite]; }; Prompt: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE] -- = BEGIN ph: PromptHandle _ NARROW[clientData]; ViewerTools.SetSelection[ph.viewer]; -- force the selection END; DoIt: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE] -- = BEGIN handle: Handle _ NARROW[clientData]; -- get our data BEGIN ENABLE { UNWIND => {IF handle.in # NIL THEN handle.in.Close[]; handle.in _ NIL}; Problem, ABORTED => {handle.tsOut.PutText[" aborted"]; GO TO done}}; iName: ROPE _ ViewerTools.GetContents[handle.cmd.inputFile]; oName: ROPE _ ViewerTools.GetContents[handle.cmd.outputFile]; wDir: ROPE = ViewerTools.GetContents[handle.cmd.workingDir]; handle.item _ NEW[EntrySeqBody[1000]]; IF iName = NIL OR oName = NIL THEN { handle.tsOut.Put[[rope["specify file names"]], [character['\n]]]; RETURN}; iName _ FS.ExpandName[iName, wDir ! FS.Error => Quit[handle, "bad input file"]].fullFName; handle.in _ OpenFile[iName]; IF handle.in # NIL THEN handle.eof _ FALSE ELSE handle.eof _ TRUE; handle.tsOut.PutText["Reading:"]; WHILE ~handle.eof DO EnterItem[handle]; IF handle.item.count MOD 50 = 0 THEN handle.tsOut.PutChar['.]; ENDLOOP; handle.tsOut.PutText["Sorting:"]; SortEntries[handle]; handle.tsOut.PutText["Writing:"]; oName _ FS.ExpandName[oName, wDir ! FS.Error => Quit[handle, "bad text output file"]].fullFName; handle.out _ FS.StreamOpen[fileName: oName, accessOptions: $create]; FOR i: CARDINAL IN [0..handle.item.count) DO WriteEntry[handle, handle.item[i]]; handle.out.PutChar['\n]; handle.item[i] _ NIL; ENDLOOP; handle.item _ NIL; EXITS done => NULL; END; -- of Enable IF handle.in # NIL THEN {handle.in.Close[]; handle.in _ NIL}; IF handle.out # NIL THEN {handle.out.Close[]; handle.out _ NIL}; handle.tsOut.Put[[character['\n]], [rope["done"]], [character['\n]]]; END; UC: PROC [c: CHAR] RETURNS [CHAR] = { RETURN[IF c IN ['a..'z] THEN VAL[c.ORD - ORD['a] + ORD['A]] ELSE c]}; CFName: PROC [name: ROPE] RETURNS [cf: ROPE] = { cName: REF TEXT _ NEW[TEXT[Rope.Length[name]]]; -- plenty long state: {last, pretitle, finished, mrsXm, mrsXr, mrsXs, dot, space, drXd, drXr} _ last; tStart: INT; FOR i: INT IN [0..Rope.Length[name]) DO c: CHAR _ UC[Rope.Fetch[name, i]]; SELECT c FROM '*, '+ => LOOP; ENDCASE => { SELECT state FROM last => IF c = ', THEN state _ pretitle; pretitle => SELECT c FROM 'M => {tStart _ cName.length; state _ mrsXm}; 'D => {tStart _ cName.length; state _ drXd}; ' => NULL; ENDCASE => state _ finished; mrsXm => IF c = 'R THEN state _ mrsXr ELSE state _ finished; mrsXr => IF c = 'S THEN state _ mrsXs ELSE state _ finished; mrsXs => IF c = '. THEN state _ dot ELSE state _ finished; drXd => IF c = 'R THEN state _ drXr ELSE state _ finished; drXr => IF c = '. THEN state _ dot ELSE state _ finished; dot => SELECT c FROM ' => state _ space; ENDCASE => {cName.length _ tStart; state _ finished}; -- throw away title space => {cName.length _ tStart; state _ finished}; -- throw away title ENDCASE; cName[cName.length] _ c; cName.length _ cName.length + 1}; ENDLOOP; RETURN[Rope.FromRefText[cName]]}; Problem: ERROR = CODE; MyBreak: IO.BreakProc -- [char: CHAR] RETURNS [IO.CharClass] -- = { RETURN [SELECT char FROM '\\, '|, '}, '\n => break, '\t, ', ' => sepr, ENDCASE => other]; }; OpenFile: PROC [name: ROPE] RETURNS [st: STREAM] = { st _ FS.StreamOpen[name, $read ! FS.Error => IF error.group # bug THEN CONTINUE]}; EnterItem: PROC [handle: Handle] = { e: REF Entry; num: LONG CARDINAL _ 0; ninedigit: BOOL _ FALSE; st: STREAM = handle.in; IF handle.eof THEN RETURN; IF handle.in = NIL THEN { MessageWindow.Append[ message: "Please open a file first", clearFirst: TRUE]; MessageWindow.Blink[ ]; ERROR ABORTED}; [] _ st.SkipWhitespace[]; IF st.EndOf[] THEN {handle.eof _ TRUE; GO TO done}; e _ ReadEntry[handle]; e.cname _ CFName[e.name[0]]; FOR i: INT IN [0..Rope.Length[e.zip]) DO c: CHAR = Rope.Fetch[e.zip, i]; SELECT c FROM IN ['0..'9] => num _ num * 10 + (c - '0); '- => ninedigit _ TRUE; ENDCASE => EXIT; ENDLOOP; IF ~ninedigit THEN num _ num * 10000; e.zipNumber _ num; IF handle.item.count = handle.item.max THEN GrowItemRec[handle]; handle.item[handle.item.count] _ e; handle.item.count _ handle.item.count + 1; EXITS done => NULL; }; GrowItemRec: PROC [h: Handle] = { n: CARDINAL; new: EntrySeq; IF h.item = NIL THEN n _ 1000 ELSE n _ h.item.max + 100; new _ NEW[EntrySeqBody[n]]; IF h.item # NIL THEN { FOR i: CARDINAL IN [0..h.item.count) DO new[i] _ h.item[i]; ENDLOOP; new.count _ h.item.count}; h.item _ new}; ReadEntry: PROC [handle: Handle] RETURNS [e: REF Entry] = { ENABLE IO.EndOfStream => {handle.eof _ TRUE; Quit[handle, "Syntax error "]}; st: STREAM _ handle.in; ch: CHAR; i: CARDINAL; e _ NEW [Entry]; IF (ch _ st.GetChar[]) # '{ THEN Quit[handle, "Syntax error "]; i _ 0; DO e.phone[i] _ GetTokenRope[st, MyBreak].token; SELECT (ch _ st.GetChar[]) FROM '\\ => IF i = nLines-1 THEN Quit[handle, "Syntax error "]; '| => EXIT; '} => RETURN; ENDCASE => Quit[handle, "Syntax error "]; i _ i + 1; ENDLOOP; i _ 0; DO e.name[i] _ GetTokenRope[st, MyBreak].token; SELECT (ch _ st.GetChar[]) FROM '\\ => IF i = nLines-1 THEN Quit[handle, "Syntax error "]; '| => EXIT; '} => RETURN; ENDCASE => Quit[handle, "Syntax error "]; i _ i + 1; ENDLOOP; i _ 0; DO e.addr[i] _ GetTokenRope[st, MyBreak].token; SELECT (ch _ st.GetChar[]) FROM '\\ => IF i = nLines-1 THEN Quit[handle, "Syntax error "]; '| => EXIT; '} => RETURN; ENDCASE => GO TO badsyntax; i _ i + 1; ENDLOOP; e.town _ GetTokenRope[st, MyBreak].token; IF st.GetChar[] = '} THEN RETURN; e.zip _ GetTokenRope[st, MyBreak].token; IF st.GetChar[] = '} THEN RETURN; GO TO badsyntax; EXITS badsyntax => Quit[handle, "Syntax error "]; }; WriteEntry: PROC [handle: Handle, e: REF Entry] = { st: STREAM _ handle.out; i: CARDINAL; st.PutChar['{]; FOR i IN SmallCount WHILE e.phone[i] # NIL DO IF i # 0 THEN st.PutChar['\\]; st.PutRope[e.phone[i]]; ENDLOOP; st.PutRope["|\t"]; IF e.phone[0] = NIL THEN st.PutRope["\t\t\t\t"]; FOR i IN SmallCount WHILE e.name[i] # NIL DO IF i # 0 THEN st.PutChar['\\]; st.PutRope[e.name[i]]; ENDLOOP; IF e.addr[0] = NIL AND e.town = NIL AND e.zip = NIL THEN { st.PutChar['}]; RETURN}; st.PutRope["|\t"]; FOR i IN SmallCount WHILE e.addr[i] # NIL DO IF i # 0 THEN st.PutChar['\\]; st.PutRope[e.addr[i]]; ENDLOOP; IF e.town = NIL AND e.zip = NIL THEN {st.PutChar['}]; RETURN}; st.PutRope["|\t"]; IF e.town # NIL THEN st.PutRope[e.town]; IF e.zip = NIL THEN {st.PutChar['}]; RETURN}; st.PutRope["|\t"]; st.PutRope[e.zip]; st.PutChar['}]; }; Quit: PROC [handle: Handle, reason: ROPE _ NIL] = { loc: INT _ 0; IF handle.in # NIL THEN { loc _ handle.in.GetIndex[]; handle.in.Close[]; handle.in _ NIL; }; handle.eof _ TRUE; handle.tsOut.Put[[rope[reason]], [integer[loc]], [character['\n]]]; ERROR Problem}; GetToken: PROC [stream: STREAM, breakProc: IO.BreakProc, buffer: REF TEXT] RETURNS[token: REF TEXT, charsSkipped: INT] = { quit, include: BOOL _ FALSE; anySeen: BOOL _ FALSE; charsSkipped _ 0; buffer.length _ 0; DO char: CHAR _ stream.GetChar[ ! IO.EndOfStream => IF buffer.length > 0 THEN EXIT ELSE REJECT]; SELECT breakProc[char] FROM break => {include _ FALSE; quit _ TRUE}; sepr => {include _ FALSE; quit _ anySeen }; other => {include _ TRUE; quit _ FALSE; anySeen _ TRUE}; ENDCASE => ERROR; IF include THEN buffer _ RefText.InlineAppendChar[buffer, char] ELSE IF quit THEN stream.Backup[char] ELSE charsSkipped _ charsSkipped + 1; IF quit THEN EXIT; ENDLOOP; RETURN[buffer, charsSkipped]; }; GetTokenRope: PUBLIC PROC [stream: STREAM, breakProc: IO.BreakProc] RETURNS [token: ROPE, charsSkipped: INT] = { buffer: REF TEXT = RefText.ObtainScratch[100]; { ENABLE UNWIND => RefText.ReleaseScratch[buffer]; tokenText: REF TEXT; [tokenText, charsSkipped] _ GetToken[stream, breakProc, buffer]; token _ IF tokenText.length = 0 THEN NIL ELSE Rope.FromRefText[tokenText]; }; RefText.ReleaseScratch[buffer]; RETURN [token, charsSkipped]; }; CompareProc: PROC [h: Handle, r1, r2: REF Entry] RETURNS [Basics.Comparison] = { IF h.zip^ THEN SELECT r1.zipNumber FROM > r2.zipNumber => RETURN[greater]; < r2.zipNumber => RETURN[less]; ENDCASE; SELECT Rope.Compare[r1.cname, r2.cname] FROM greater => RETURN[greater]; less => RETURN[less]; ENDCASE; RETURN[equal]}; SortEntries: PROC [h: Handle] = { Greater: PROC [r1, r2: REF Entry] RETURNS [BOOL] = { RETURN[CompareProc[h, r1, r2] = greater]}; Sort[h.item, h.item.count, Greater]; }; Sort: PROC [ a: EntrySeq, n: CARDINAL, greater: PROC [r1, r2: REF Entry] RETURNS [BOOL]] = { i: CARDINAL; temp: REF Entry; SiftUp: PROC [l, u: CARDINAL] = { s: CARDINAL; key: REF Entry _ a[l-1]; DO s _ l*2; IF s > u THEN EXIT; IF s < u AND greater[a[s+1-1], a[s-1]] THEN s _ s+1; IF greater[key, a[s-1]] THEN EXIT; a[l-1] _ a[s-1]; l _ s; ENDLOOP; a[l-1] _ key}; FOR i DECREASING IN [2..n/2] DO SiftUp[i, n]; ENDLOOP; FOR i DECREASING IN [2..n] DO SiftUp[1, i]; temp _ a[1-1]; a[1-1] _ a[i-1]; a[i-1] _ temp; ENDLOOP}; Commander.Register[key: "OldSortDir", proc: MakeTool, doc: "Sort a church directory" ]; [ ] _ MakeTool[NIL]; -- and create an instance END.  OldSortDir.mesa; Last Edited by: Sweet, September 13, 1985 11:32:50 pm PDT The Containers interface is used to create an outer envelope or "container" for the different sections below. For uniformity, we define some standard distances between entries in the tool. default the width so that it will be computed for us -- default the width so that it will be computed for us -- default the width so that it will be computed for us -- force the selection into the user input field force the selection into the user input field various initializations do the work extract interesting data enter into list to be sorted one should SkipWhitespace before calling (and check for eof) copied from IOSearchImpl because it didn't handle empty tokens properly Sort by various keys Κ– "Cedar" style˜Iproc– "Cedar" stylešœ™J™9unitšΟk ˜ Lšœ˜J˜Jšœ˜Jšœ œ˜(J˜ Jšœ œ/˜?Jšœ˜Jšœ˜J˜J˜Jšœ˜Jšœœ˜J˜J˜ J˜Jšœœ˜-Jšœ œ˜%Jšœ œ˜Jšœ œ0˜A—šœ œœ˜Jšœ2œ]˜˜—Lš œ˜Jšœ½™½Jšœ œΟc&˜BJšœ œž'˜CJšœ œž+˜HJšœœœ˜Jšœœœœ˜Jšœœ˜J˜˜J˜—šœ œœ˜Jšœ/œ˜4—Jšœœœ ˜#šœ"˜'Jšœ˜Jšœ œ˜emphasisšœžœ˜>Jšœž ˜:Jšœœž4˜DJšœž˜0Jšœ œœž'˜>—Jšœž!˜4JšœP˜PJšœ'˜'Jšœ)ž˜=Jšœ˜Jšœ)ž˜@Jšœ˜—J˜šΟnœœœ˜.Jšœ-ž(˜Ušœ˜JšœLœ˜U—šœ<˜Jšœ%˜%Jšœœ ˜6šœ#˜#šœ˜Jšœ˜Jšœ˜Jšœ7™7Jšœž4˜EJšœ˜Jšœ˜Jšœœ˜—Jšœ ˜ Jšœž)˜:—Jšœ˜šœ$˜$Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ ˜ Jšœ œ˜Jšœœ˜—J˜Jšœ˜—šŸœœ œ œœœœ˜DJ˜Jšœœœ ˜šœ˜šœ˜Jšœ ˜ J˜Jšœ˜Jšœ7™7Jšœž4˜EJšœ˜Jšœœ˜—Jšœ˜Jšœž(œ˜<—J•StartOfExpansion[]š œ,œ œœœ˜lJšœ˜—šŸœœ œ˜5šœ#˜#šœ˜Jšœ ˜ J˜Jšœ˜Jšœ7™7Jšœž4˜EJšœ˜Jšœœ˜—Jšœ ˜ Jšœž(œ˜>—Jšœ˜—J˜Jšœ ˜ J˜Jšœœ˜ Jšœ ˜ J˜Jšœd˜dJšœ ˜ J˜Jšœ0˜0Jšœ ˜ J˜Jšœ2˜2Jšœ ˜ J˜Jšœ˜J˜—šŸ œΠckœ˜#Jšœœœœ˜(J˜Jš œ"œœ œœ˜mJ˜J˜—–† -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE] -- šœ …œ˜©Jšœ-™-Jšœœ ˜&Jšœ&ž˜Jšœ˜—J˜!Jšœ˜J˜!šœœ˜$N˜<—JšœD˜Dšœœœ˜,Jšœ#˜#J˜Jšœœ˜Jšœ˜—Jšœœ˜š˜Jšœœ˜ —Jšœž ˜Jšœ œœ!œ˜=Jšœœœ#œ˜@J˜EJšœ˜J˜—š œœœœœ˜%Jšœœœ œœœœœœ˜EJ˜—š Ÿœœœœœ˜0Jš œœœœœž˜>J˜WJšœœ˜ šœœœ˜'Jšœœœ˜"šœ˜ Jšœ œ˜šœ˜ šœ˜Jšœœœ˜(šœ œ˜Jšœ-˜-Jšœ,˜,Jšœœ˜ Jšœ˜—Jšœ œœœ˜J˜Jšœ œœ˜(Jšœ œœœ˜-J˜Jšœ˜Jšœ˜J˜J˜—šŸœœœœ˜3Nšœœ˜ šœ œœ˜Nšœ˜Jšœœ˜#Nšœ˜—Nšœ œ˜JšœC˜CJšœ ˜J˜—JšœG™Gš Ÿœœ œ œœœ˜JJšœ œœ˜/Jšœœœ˜Jšœ œœ˜Jšœ˜J˜š˜šœœ˜ Jš œœœœœ˜P—šœ˜Jšœœ œ˜(Jšœœ˜+Jšœœ œ œ˜8Jšœœ˜—Jšœ œ0˜?š˜Jšœœœ!˜F—Jšœœœ˜Jšœ˜—Jšœ˜Jšœ˜—š Ÿ œœœ œ œ ˜CJšœœœ˜,Jšœœœ˜.šœœœ#˜2Jšœ œ˜Jšœ@˜@JšœJ˜JJ˜—Jšœ˜Jšœ˜J˜J˜—Jšœ™J™šŸ œœœœ˜Pšœœœ˜'Jšœœ ˜"Jšœœ˜Jšœ˜—šœ"˜,Jšœ œ ˜Jšœœ˜Jšœ˜—Jšœ ˜J˜—šŸ œœ˜!š Ÿœœ œœœ˜4Jšœ$˜*—Jšœ$˜$J˜J˜—šŸœœ˜ J˜ Jšœœ˜ Jš œ œ œœœ˜5Jšœœ˜ Jšœœ˜J˜šŸœœœ˜!Jšœœ˜ Jšœœ˜š˜J˜Jšœœœ˜Jšœœœ ˜4Jšœœœ˜"J˜J˜Jšœ˜—J˜J˜—Jš œ œœ œœ˜6šœ œœ˜J˜ J˜J˜J˜Jšœ˜ J˜——J˜šœ5˜5Jšœ!˜!—Mšœœž˜.I modheaderšœ˜Ic˜O˜J˜—…—5ΚLε