{INCLUDE FILE UABC2 -- IMPLEMENTATION OF UABC} {Copyright 1983, 1984, Apple Computer, Inc.} {TProcess-TDocDirectory-TDocManager-TClipboard-TCommand-TCutCopyCommand-TPasteCommand} {Segments: SgABCini(tialize and Terminate), SgABCres(ident), SgABCc(o)ld, SgABCdbg, SgABCpri(nting)} {$IFC fRngABC} {$R+} {$ELSEC} {$R-} {$ENDC} {$IFC fSymABC} {$D+} {$ELSEC} {$D-} {$ENDC} CONST toolKitType = 9; { picture comment IDs for pasting into LisaDraw } cPicGeDwg = 100; cPicTxtBegin = 101; cPicTxtEnd = 102; cPicGrpBegin = 103; cPicGrpEnd = 104; TYPE TPrPrfAlias = RECORD {Alias for Print Preference} CASE INTEGER OF {$IFC libraryVersion <= 20} { P E P S I } 1: (prPrf: TPrPrf; prIns: TPrIns); {$ELSEC} 1: (prPrf: TPrRec); {$ENDC} { S P R I N G} 2: (reserve: TPrReserve); END; TMapTable = RECORD {Alias for menuBar.mapping TArray} header: TArrayHeader; table: ARRAY [1..8000] OF TWmgrCmd; END; TMapPtr = ^TMapTable; TMapHandle = ^TMapPtr; VAR alerts: TAlertFile; {The Alert Manager alert handle for the Main Phrase File} event: EventRecord; {The last event received by this process} {$IFC fDbgABC} hadToBindClip: BOOLEAN; {BindHeap had to bind the Clipboard} {$ENDC} scrRgn1ForDrawHdgs: RgnHandle; {Reserved for use dy TPaginatedView.AdornPageOnScreen} scrRgn2ForDrawHdgs: RgnHandle; {Reserved for use dy TPaginatedView.AdornPageOnScreen} wmgrMenus: ARRAY [1..maxMenus] OF MenuInfo; cSelection: TClass; {The TClass of TSelection, used by TPasteCmd.Perform} picData: TH; {Pre-allocated handle on MainHeap used for picture comments} PROCEDURE InAllMenusDo(iffLoaded: BOOLEAN; theCommand: TCmdNumber; PROCEDURE doProc(VAR menu: MenuInfo; itemIndex: INTEGER)); FORWARD; {$S sScroll} PROCEDURE PreSbList(VAR sbList: TSbList; scrollBar: TScrollBar); BEGIN {$IFC fTrace}BP(1);{$ENDC} sbList.hz := POINTER(ORD(scrollBar.Heap)); IF scrollBar.firstBox = NIL THEN sbList.hsbFst := hsbNil ELSE sbList.hsbFst := POINTER(scrollBar.firstBox.sBoxID); {$IFC fTrace}EP;{$ENDC} END; {$S sScroll} PROCEDURE PostSbList(sbList: TSbList; scrollBar: TScrollBar); VAR scroller: TScroller; BEGIN {$IFC fTrace}BP(1);{$ENDC} IF sbList.hsbFst = hsbNil THEN scroller := NIL ELSE scroller := POINTER(RefconSb(sbList.hsbFst)); scrollBar.firstBox := scroller; {$IFC fTrace}EP;{$ENDC} END; {$S sStartup} PROCEDURE GetPrefixPart{(wholeName: S255; VAR filePart: TFilePath)}; (*'{prefix}'*) (* This works ONLY on Desktop Manager file names of the form '-volname-{prefix}suffix' *) VAR centerHyphen: INTEGER; BEGIN {$IFC fTrace}BP(1);{$ENDC} centerHyphen := Pos('-{', wholeName); filePart := Copy(wholeName, centerHyphen+1, Pos('}',wholeName) - centerHyphen); {$IFC fTrace}EP;{$ENDC} END; {$S sCldInit} FUNCTION ToolOfFile{(wholeName: S255): LONGINT}; VAR toolNumber: LONGINT; toolPrefix: TFilePath; cvResult: TConvResult; BEGIN {$IFC fTrace}BP(7);{$ENDC} GetPrefixPart(wholeName, toolPrefix); Delete(toolPrefix, 1, 2); (* The '{T' *) Delete(toolPrefix, Length(toolPrefix), 1); (* The final '}' *) StrToLInt(@toolPrefix, toolNumber, cvResult); IF cvResult <> cvValid THEN ToolOfFile := 0 ELSE ToolOfFile := toolNumber; {$IFC fTrace}EP;{$ENDC} END; {$S sCldInit} FUNCTION ToolOfProcess{(processId: LONGINT): LONGINT}; VAR prcsInfo: ProcInfoRec; error: INTEGER; BEGIN {$IFC fTrace}BP(6);{$ENDC} Info_Process(error, processID, prcsInfo); IF error > 0 THEN ToolOfProcess := 0 ELSE ToolOfProcess := ToolOfFile(prcsInfo.progPathname); {$IFC fTrace}EP;{$ENDC} END; {$IFC fDbgABC} {$S SgABCdbg} PROCEDURE ReportEvent; VAR winTitle: Str255; BEGIN Write(toolName, ' P=#', myProcessId:1, ' received '); WITH event DO BEGIN CASE what OF buttonDown: Write('Button-down'); buttonUp: Write('Button-up'); folderActivate: Write('Activate'); folderDeactivate: Write('Deactivate'); folderMoved: Write('Window-moved'); folderUpdate: Write('Update'); keyDown: Write('Key-press'); filerEvent: Write('Desktop'); OTHERWISE Write('Miscellaneous'); END; Write(' event for the '); IF who = alertFolder THEN WriteLn('Alert Box') ELSE IF who = dialogFolder THEN WriteLn('Dialog Box') ELSE IF who = scrapFolder THEN WriteLn('Clipboard') ELSE IF who = menuFolder THEN WriteLn('Menu Bar') ELSE BEGIN GetFldrTitle(who, winTitle); WriteLn('window titled "', winTitle, '"'); END; END; END; {$S SgABCdbg} PROCEDURE ReportFilerEvent(flrParams: FilerExt); BEGIN Write(' '); WITH flrParams DO BEGIN CASE theFlrOp OF fcClose: Write('Close '); fcCopy: Write('Copy '); fcDfClose: Write('Doc File Close'); fcNone: Write('Open Tool '); fcPut: Write('Put '); fcResume: Write('Open Doc '); fcShred: Write('Shred '); fcSuspend: Write('Suspend '); fcTerminate: Write('Terminate '); OTHERWISE Write('Unknown!!! '); END; {$IFC LibraryVersion <= 20} WriteLn(' theErr=', theErr:1, ' theDF=', theDF:1); WriteLn(' thePrefix="', thePrefix, '"'); {$ELSEC} WriteLn(' theErr=', theErr:1, ' theOffset=', theOffset:1, ' theDF=', theDF:1); WriteLn(' thePassword="', thePassword, '"'); WriteLn(' thePrefix="', thePrefix, '"'); WriteLn(' theResult="', theResult, '"'); {$ENDC} END; END; {$ENDC} {$S sError} PROCEDURE AlErrProc; BEGIN StopAlert(alerts, 2); process.Complete(FALSE); END; {$S sCldInit} FUNCTION ExpandHeap(heap: THeap; bytesNeeded: INTEGER): INTEGER; VAR alias: RECORD CASE INTEGER OF 1: (address: TPPrelude); 2: (high, low: INTEGER) END; preludePtr: TPPrelude; oldHeapSize: LONGINT; newHeapSize: LONGINT; BEGIN {$IFC fTrace}BP(1);{$ENDC} alias.address := POINTER(ORD(heap)); alias.low := 0; preludePtr := alias.address; {$IFC fDbgABC} IF boundDocument.dataSegment.preludePtr <> preludePtr THEN ABCBreak('boundDocument''s preludePtr <> preludePtr in ExpandHeap', ORD(heap)); {$ENDC} oldHeapSize := CbOfHz(POINTER(ORD(heap))); boundDocument.ExpandMemory(bytesNeeded); WITH boundDocument.dataSegment.preludePtr^ DO newHeapSize := docSize - preludeSize; ExpandHeap := newHeapSize - oldHeapSize; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCcld} PROCEDURE PicTextBegin{(alignment: TAlignment)}; TYPE TpByte = ^Byte; ThByte = ^TpByte; VAR FEalign: Byte; BEGIN IF genClipPic THEN BEGIN FEalign := ORD(alignment) + 1; IF FEalign > 3 THEN FEalign := 1; {aLeft} ThByte(picData)^^ := FEalign; {currently, picData is always a handle to 1 byte} {$IFC LibraryVersion <= 20} PicComment(cPicTxtBegin, SIZEOF(FEalign), Handle(picData)); {$ELSEC} PicComment(cPicTxtBegin, SIZEOF(FEalign), QDHandle(picData)); {$ENDC} END; END; {$S SgABCcld} PROCEDURE PicTextEnd; { end of series } BEGIN IF genClipPic THEN PicComment(cPicTxtEnd, 0, NIL); END; {$S SgABCcld} PROCEDURE PicGrpBegin; { beginning of a series of grouped objects } BEGIN IF genClipPic THEN PicComment(cPicGrpBegin, 0, NIL); END; {$S SgABCcld} PROCEDURE PicGrpEnd; { end of series } BEGIN IF genClipPic THEN PicComment(cPicGrpEnd, 0, NIL); END; {$S sError} FUNCTION FilerReason(error: INTEGER): FReason; BEGIN {$IFC fTrace}BP(1);{$ENDC} FilerReason := allOk; IF error > 0 THEN CASE error OF 309, erNoDiskSpace: FilerReason := noDiskSpace; 306, 311, 315, erNoMemory: FilerReason := noMemory; {$IFC LibraryVersion > 20} 1294, erWrongPassword: FilerReason := wrongPassword; {$ENDC} erBadData: FilerReason := badData; erPassword, erVersion, 955, 957, 958, erCantRead: FilerReason := cantRead; 961, 962, erCantWrite: FilerReason := cantWrite; erDirtyDoc: FilerReason := dirtyDoc; erNoMoreDocs: FilerReason := noMoreDocs; erAborted: FilerReason := aUserAbort; OTHERWISE FilerReason := internalError; END; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCini} PROCEDURE InitProcess; CONST maxNameLen = 63; {this definition must be consistent with the DeskTop Manager} TYPE TDeskLabel = RECORD {this definition must be consistent with the DeskTop Manager} version: INTEGER; name: STRING[maxNameLen]; (** other stuff we are not interested in kind: INTEGER; toolOnly: BOOLEAN; multiDoc: BOOLEAN; windLoc: Rect; {plus there are other fields added for Spring release} **) END; TPPathName = ^Pathname; VAR copyright: S255; prcsInfo: ProcInfoRec; progName: TFilePath; error: INTEGER; toolLabel: TDeskLabel; actual: LONGINT; len: INTEGER; pPathName: TPPathname; BEGIN {$IFC fTrace}BP(1);{$ENDC} {Tool Kit Library copyright notice (application must have its own notice in addition)} copyright := 'Copyright 1983, 1984, Apple Computer, Inc.'; {Initialize Various Globals} idleTime := -1; inBackground := FALSE; {$IFC fDbgABC} fCountHeap := FALSE; fExperimenting := FALSE; eventDebug := FALSE; {Don't trace window manager events} {$ENDC} activeWindowID := 0; allowAbort := TRUE; boundDocument := NIL; boundClipboard := NIL; closedDocument := NIL; currentWindow := NIL; currentDocument := NIL; docList := NIL; cursorShape := noCursor; {Assign process and tool globals} myProcessID := my_id; Info_Process(error, myProcessID, prcsInfo); IF error > 0 THEN InitErrorAbort(error); progName := prcsInfo.progPathName; SplitFilePath(progName, toolVolume, toolPrefix); GetPrefixPart(progName, toolPrefix); (*'{Tnn}'*) myTool := ToolOfFile(progName); {Read name of tool} pPathName := @progName; Read_Label(error, pPathName^, ORD(@toolLabel), SIZEOF(toolLabel), actual); IF (error <= 0) AND (Length(toolLabel.name) > 0) AND (Length(toolLabel.name) <= maxNameLen) THEN toolName := toolLabel.name ELSE BEGIN LIntToStr(myTool, @toolName); toolName := CONCAT('Tool ', toolName); END; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCcld} {Segmentation ???} FUNCTION GetTime: LONGINT; BEGIN {$IFC fTrace}BP(1);{$ENDC} GetTime := Time; {$IFC fTrace}EP;{$ENDC} END; METHODS OF TProcess; {$S SgABCini} FUNCTION {TProcess.}CREATE{(object: TObject; heap: THeap): TProcess}; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF object = NIL THEN object := NewObject(heap, THISCLASS); SELF := TProcess(object); {$IFC fTrace}EP;{$ENDC} END; {$S sStartup} FUNCTION {TProcess.}AbortRequest{: BOOLEAN}; BEGIN {$IFC fTrace}BP(2);{$ENDC} IF allowAbort THEN AbortRequest := Abort {ask Window Manager} ELSE AbortRequest := FALSE; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCcld} { If allowAbort is FALSE, simply calls fs.XferSequential. Otherwise, transfers in increments of chunksize and sets fs.Error to erAborted IF command period is pressed during the transfer. Returns with an incomplete transfer IF command period or any other error occurs during the transfer. } PROCEDURE {TProcess.}AbortXferSequential{(whichWay: xReadWrite; pFirst: Ptr; numBytes, chunksize: LONGINT; fs: TFileScanner)}; VAR xferAmount: LONGINT; actual: LONGINT; BEGIN {$IFC fTrace}BP(6);{$ENDC} IF allowAbort THEN BEGIN actual := 0; WHILE (numBytes > 0) AND (fs.error <= 0) AND NOT (fs.atEnd AND (whichWay = xRead)) DO BEGIN IF numbytes > chunksize THEN xferAmount := chunksize ELSE xferAmount := numbytes; IF process.AbortRequest THEN fs.error := erAborted ELSE BEGIN fs.XferSequential(whichWay, pFirst, xferAmount); xferAmount := fs.actual; {$IFC fDbgABC} IF (xferAmount <= 0) AND (fs.error <= 0) THEN ABCbreak('In TProcess.AbortXferSequential, fs.actual <= 0', xferAmount); {$ENDC} actual := actual + xferAmount; numbytes := numBytes - xferAmount; pFirst := POINTER(ORD(pFirst) + xferAmount); END; END; fs.actual := actual; {make believe we xferred it all at once} END ELSE fs.XferSequential(whichWay, pFirst, numBytes); {$IFC fTrace}EP;{$ENDC} END; {$S sAlert} PROCEDURE {TProcess.}ArgAlert{(whichArg: TArgAlert; argText: S255)}; BEGIN {$IFC fTrace}BP(7);{$ENDC} ArgAlert(whichArg, argText); {$IFC fTrace}EP;{$ENDC} END; {$S sAlert} FUNCTION {TProcess.}Ask{(phraseNumber: INTEGER): INTEGER}; BEGIN {$IFC fTrace}BP(7);{$ENDC} ArgAlert(0, toolName); {$IFC LibraryVersion > 20} IF activeWindowID = 0 THEN Ask := BackgroundAlert(alerts, phraseNumber, AskProc) ELSE {$ENDC} Ask := AskAlert(alerts, phraseNumber); {$IFC fTrace}EP;{$ENDC} END; {$S sAlert} PROCEDURE {TProcess.}BeginWait{(phraseNumber: INTEGER)}; BEGIN {$IFC fTrace}BP(7);{$ENDC} ArgAlert(0, toolName); WaitAlert(alerts, phraseNumber); {$IFC fTrace}EP;{$ENDC} END; {$S sStartup} PROCEDURE {TProcess.}BindCurrentDocument; BEGIN {$IFC fTrace}BP(6);{$ENDC} IF (boundDocument <> currentDocument) AND (boundDocument <> NIL) THEN boundDocument.Unbind; IF (boundClipboard <> currentDocument) AND (boundClipboard <> NIL) THEN boundClipboard.Unbind; IF currentDocument <> NIL THEN currentDocument.Bind; {$IFC fTrace}EP;{$ENDC} END; {$S sAlert} FUNCTION {TProcess.}Caution{(phraseNumber: INTEGER): BOOLEAN}; BEGIN {$IFC fTrace}BP(7);{$ENDC} ArgAlert(0, toolName); {$IFC LibraryVersion > 20} IF activeWindowID = 0 THEN Caution := (BackgroundAlert(alerts, phraseNumber, CautionProc) = ORD(TRUE)) ELSE {$ENDC} Caution := CautionAlert(alerts, phraseNumber); {$IFC fTrace}EP;{$ENDC} END; {$S sStartup} PROCEDURE {TProcess.}ChangeCursor{(cursorNumber: TCursorNumber)}; BEGIN {$IFC fTrace}BP(4);{$ENDC} IF cursorNumber <> cursorShape THEN BEGIN SELF.DoCursorChange(cursorNumber); cursorShape := cursorNumber; END; IF cursorNumber > icrsLast THEN SetStdCursor(icrsEscape); {$IFC fTrace}EP;{$ENDC} END; {$S SgABCini} PROCEDURE {TProcess.}Commence{(phraseVersion: INTEGER)}; VAR aFile: TFile; cacheSize: INTEGER; cacheBytes: INTEGER; i: INTEGER; oneChar: STRING[1]; manualPat: Pattern; error: INTEGER; prPrfAlias: TPrPrfAlias; str: S255; convResult: TConvResult; BEGIN {$IFC fTrace}BP(7);{$ENDC} {Open Phrase File} aFile := TFile.CREATE(NIL, mainHeap, CONCAT(toolVolume, toolPrefix, 'PHRASE'), ''); phraseFile := aFile.ScannerFrom(0, [fRead]); InitErrorAbort(phraseFile.error); {Read Menus} menuBar := TMenuBar.CREATE(NIL, mainHeap, phraseFile); {Initialize and Read Alerts} cacheSize := phraseFile.ReadNumber(2); cacheBytes := phraseFile.ReadNumber(2); InitErrorAbort(phraseFile.error); InitAlerts(cacheSize, cacheBytes, POINTER(ORD(mainHeap)), NIL, @AlErrProc); InitErrorAbort(alertError); alerts := ReadAlerts(phraseFile.refnum, phraseVersion); InitErrorAbort(alertError); {Read Word Delimiters} GetAlert(alerts, phWordDelimiters, @wordDelimiters); IF Length(wordDelimiters) > 67 THEN BEGIN ABCBreak('More than 67 characters in the word delimiter string--phrase number', phWordDelimiters); { Set error to something so we don't continue } InitErrorAbort(erInternal); END; {Read "OK" and "Cancel"} GetButn(0, @cancelString); StrUpperCased(@cancelString); GetButn(1, @okString); StrUpperCased(@okString); GetAlert(alerts, phNewHeading, @dfltNewHeading); {+SW+} GetAlert(alerts, phPage, @varPage); {+SW+} GetAlert(alerts, phTitle, @varTitle); {+SW+} GetAlert(alerts, phCountry, @str); StrToInt(@str, countryCode, convResult); IF convResult <> cvValid THEN countryCode := 0; {Create a handle to use in picture comments} picData := HAllocate(THz(mainHeap), 1); (**** {Read Tool Name} GetAlert(alerts, phToolName, @toolName); IF Length(toolName) > 67 THEN BEGIN ABCBreak('More than 67 characters in the tool name string--phrase number', phToolName); InitErrorAbort(erInternal); END; ****) {Read Tool Name from file label is done in InitProcess} IF onDesktop THEN BEGIN {Initialize Print Manager, while Alert Segment is still Resident} {$IFC LibraryVersion <= 20} PrMgrInit(error); InitErrorAbort(error); {$ELSEC} PrMgrInit; {$ENDC} END; {Initialize Scroll Bar and Cursor Library} InitWmlSb; InitWmlCrs(error); InitErrorAbort(error); {$IFC LibraryVersion <= 20 AND FALSE} {do it this way in case we need it back for the Pepsi version} {Create fonts} fonts[ 0] := TFont.CREATE(NIL, mainHeap, sysText); {System Font } fonts[ 1] := TFont.CREATE(NIL, mainHeap, p15Tile); {15 pitch Gothic } fonts[ 2] := TFont.CREATE(NIL, mainHeap, p12tile); {12 pitch Modern } fonts[ 3] := TFont.CREATE(NIL, mainHeap, elite); {12 pitch Elite } fonts[ 4] := TFont.CREATE(NIL, mainHeap, p10tile); {10 pitch Modern } fonts[ 5] := TFont.CREATE(NIL, mainHeap, p10cent); {10 pitch Courier} fonts[ 6] := TFont.CREATE(NIL, mainHeap, tile12 ); {PS Modern } fonts[ 7] := TFont.CREATE(NIL, mainHeap, cent12 ); {PS Executive } fonts[ 8] := TFont.CREATE(NIL, mainHeap, tile18 ); {1/4 inch Modern } fonts[ 9] := TFont.CREATE(NIL, mainHeap, cent18 ); {1/4 inch Classic} fonts[10] := TFont.CREATE(NIL, mainHeap, tile24 ); {1/3 inch Modern } fonts[11] := TFont.CREATE(NIL, mainHeap, cent24 ); {1/3 inch Classic} {$ENDC} {Specify suspend-file suffixes} oneChar := '0'; FOR i := 1 TO maxSegments DO BEGIN oneChar[1] := CHR(48+i); suspendSuffix[i] := CONCAT('$S', oneChar); END; {Initialize other globals} SetPt(zeroPt, 0, 0); SetRect(zeroRect, 0, 0, 0, 0); SetRect(hugeRect, 0, 0, $3FFF, $3FFF); SetLPt(zeroLPt, 0, 0); SetLRect(zeroLRect, 0, 0, 0, 0); SetLRect(hugeLRect, 0, 0, $3FFFFFFF, $3FFFFFFF); orthogonal[v] := h; orthogonal[h] := v; docList := TList.CREATE(NIL, mainHeap, 1); highToggle[FALSE] := hOnToOff; highToggle[TRUE] := hOffToOn; highLevel[FALSE] := hOffToDim; highLevel[TRUE] := hOffToOn; PenNormal; GetPenState(normalPen); PenSize(2, 2); PenMode(patXor); PenPat(gray); GetPenState(highPen[hDimToOff]); GetPenState(highPen[hOffToDim]); PenMode(notPatXor); PenPat(gray); GetPenState(highPen[hOnToDim]); GetPenState(highPen[hDimToOn]); PenMode(patXor); PenPat(black); GetPenState(highPen[hOffToOn]); GetPenState(highPen[hOnToOff]); PenSize(3, 2); PenMode(patXOr); PenPat(gray); GetPenState(autoBreakPen); StuffHex(@manualPat, 'CC663399CC663399'); PenPat(manualPat); GetPenState(manualBreakPen); StuffHex(@marginPattern, '8000000008000000'); PenNormal; PenPat(manualPat); GetPenState(limboPen); SetPt(screenRes, 90, 60); {Lisa 1.0 screen} {better--get from phrase file} screenRightEdge := 720; {redundant -- screenBits.bounds.right shd be the same} SetLRect(stdMargins, screenRes.h, screenRes.v, - screenRes.h, -screenRes.v); PenNormal; noPad := TPad.CREATE(NIL, mainHeap, zeroRect, hugeLRect, screenRes, screenRes, NIL); (***** Do this in TPad creation block, via coercion noPad.PatToLPat(white, lPatWhite); noPad.PatToLPat(black, lPatBlack); noPad.PatToLPat(gray, lPatGray); noPad.PatToLPat(ltGray, lPatLtGray); noPad.PatToLPat(dkGray, lPatDkGray); *****) MakeTypeStyle(famClassic, size18Point, [], cornerNumberStyle); theMarginPad := TMarginPad.CREATE(NIL, mainHeap); theBodyPad := theMarginPad.bodyPad; IF crashPad = NIL THEN crashPad := theMarginPad; clipboard := TClipboard.CREATE(NIL, mainHeap); padRgn := NewRgn; focusRgn := thePort^.visRgn; focusStkPtr := 0; focusArea := NIL; genClipPic := FALSE; amPrinting := FALSE; useAltVisRgn := FALSE; altVisRgn := NewRgn; scrollRgn := NewRgn; scrRgn1ForDrawHdgs := NewRgn; scrRgn2ForDrawHdgs := NewRgn; blinkOnCentiSecs := caretOnTime; blinkOffCentiSecs := caretOffTime; PrPrfDefault(prPrfAlias.prPrf); clipPrintPref := prPrfAlias.reserve; { Final check for Abort in init } InitErrorAbort(0); {$IFC fTrace}EP;{$ENDC} END; {$S SgABCini} PROCEDURE {TProcess.}Complete{(allIsWell: BOOLEAN)}; VAR s: TListScanner; document: TDocManager; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF NOT (allIsWell OR amDying) THEN BEGIN ImDying; {Do this first} IF (boundClipboard <> NIL) AND (scrapProcess = myProcess) THEN {*** Sufficient & necessary? ***} BackOutOfScrap; amDying := TRUE; END; {$IFC fDbgABC} IF NOT allIsWell THEN ABCBreak('Process.Complete(FALSE)', 0); {$ENDC} IF docList <> NIL THEN BEGIN s := docList.Scanner; docList := NIL; WHILE s.Scan(document) DO document.Complete(allIsWell); END; HALT; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCcld} PROCEDURE {TProcess.}CopyExternalDoc(VAR error: INTEGER; externalName, volumePrefix: TFilePath); BEGIN {$IFC fTrace}BP(6);{$ENDC} {$IFC fDbgABC} ABCbreak('TProcess.CopyExternalDoc was not overridden', 0); {$ENDC} {$IFC fTrace}EP;{$ENDC} END; {$S sAlert} PROCEDURE {TProcess.}CountAlert{(whichCtr: TAlertCounter; counter: INTEGER)}; BEGIN {$IFC fTrace}BP(7);{$ENDC} CountAlert(whichCtr, counter); {$IFC fTrace}EP;{$ENDC} END; {$S sStartup} PROCEDURE {TProcess.}DoCursorChange{(cursorNumber: TCursorNumber)}; BEGIN {$IFC fTrace}BP(4);{$ENDC} SetStdCursor(cursorNumber); {$IFC fTrace}EP;{$ENDC} END; {$IFC fDebugMethods} {$S SgABCini} PROCEDURE {TProcess.}DontDebug; BEGIN {$IFC fTrace}BP(6);{$ENDC} fCheckIndices := FALSE; {$IFC fDbgABC} eventDebug := FALSE; fCountHeap := FALSE; fExperimenting := FALSE; {$ENDC} {$IFC fTrace}EP;{$ENDC} END; {$ENDC} {$S sAlert} PROCEDURE {TProcess.}DrawAlert(phraseNumber: INTEGER; marginLRect: LRect); VAR rectInWindow: Rect; BEGIN {$IFC fTrace}BP(7);{$ENDC} ArgAlert(0, toolName); thePad.LRectToRect(marginLRect, rectInWindow); DrawAlert(alerts, phraseNumber, rectInWindow); {$IFC fTrace}EP;{$ENDC} END; {$IFC fDbgABC} {$S SgABCdbg} PROCEDURE {TProcess.}DumpGlobals; VAR str: S8; PROCEDURE AbortDumpVar(pVariable: Ptr; nameAndType: S255); BEGIN IF CheckKeyPress('Process global variable dump') THEN BEGIN WriteLn; WriteLn; Exit(DumpGlobals); END; DumpVar(pVariable, nameAndType); END; BEGIN WriteLn; WriteLn('--- IMPORTANT GLOBAL VARIABLES OF THE PROCESS ---'); WriteLn; AbortDumpVar(@activeWindowID, 'activeWindowID: Ptr'); AbortDumpVar(@allowAbort, 'allowAbort: BOOLEAN'); AbortDumpVar(@boundClipboard, 'boundClipboard: TClipboard'); AbortDumpVar(@boundDocument, 'boundDocument: TDocManager'); AbortDumpVar(@clickState, Concat('clickState: RECORD where: Point; when: LONGINT;', 'clickCount: INTEGER; fShift: BOOLEAN; fOption: BOOLEAN; fApple: BOOLEAN END')); AbortDumpVar(@clipboard, 'clipboard: TClipboard'); AbortDumpVar(@closedBySuspend, 'closedBySuspend: BOOLEAN'); AbortDumpVar(@closedDocument, 'closedDocument: TDocManager'); AbortDumpVar(@currentDocument, 'currentDocument: TDocManager'); AbortDumpVar(@currentWindow, 'currentWindow: TWindow'); AbortDumpVar(@cursorShape, 'cursorShape: INTEGER'); AbortDumpVar(@deferUpdate, 'deferUpdate: BOOLEAN'); AbortDumpVar(@docList, 'docList: TList'); AbortDumpVar(@genClipPic, 'genClipPic: BOOLEAN'); AbortDumpVar(@idleTime, 'idleTime: LONGINT'); AbortDumpVar(@inBackground, 'inBackground: BOOLEAN'); AbortDumpVar(@menuBar, 'menuBar: TMenuBar'); AbortDumpVar(@myProcessID, 'myProcessID: LONGINT'); AbortDumpVar(@myTool, 'myTool: LONGINT'); AbortDumpVar(@process, 'process: TProcess'); AbortDumpVar(@toolName, 'toolName: STRING[67]'); AbortDumpVar(@toolPrefix, 'toolPrefix: STRING[255]'); AbortDumpVar(@toolVolume, 'toolVolume: STRING[255]'); WriteLn; WriteLn; END; {$ENDC} {$S sAlert} PROCEDURE {TProcess.}EndWait; BEGIN {$IFC fTrace}BP(7);{$ENDC} {$IFC LibraryVersion <= 20} HideFolder(alertFolder); {$ELSEC} EndWaitAlert; {$ENDC} {$IFC fTrace}EP;{$ENDC} END; {$S sAlert} PROCEDURE {TProcess.}GetAlert{(phraseNumber: INTEGER; VAR theText: S255)}; BEGIN {$IFC fTrace}BP(7);{$ENDC} GetAlert(alerts, phraseNumber ,@theText); {$IFC fTrace}EP;{$ENDC} END; {$S Override} FUNCTION {TProcess.}NewDocManager{(volumePrefix: TFilePath; openAsTool: BOOLEAN): TDocManager}; BEGIN {$IFC fTrace}BP(7);{$ENDC} NewDocManager := TDocManager.CREATE(NIL, mainHeap, volumePrefix); {$IFC fTrace}EP;{$ENDC} END; {$S sAlert} PROCEDURE {TProcess.}Note{(phraseNumber: INTEGER)}; {$IFC LibraryVersion > 20} VAR dummy: INTEGER; {$ENDC} BEGIN {$IFC fTrace}BP(7);{$ENDC} ArgAlert(0, toolName); {$IFC LibraryVersion > 20} IF activeWindowID = 0 THEN dummy := BackgroundAlert(alerts, phraseNumber, NoteProc) ELSE {$ENDC} NoteAlert(alerts, phraseNumber); {$IFC fTrace}EP;{$ENDC} END; { NOTE: StopCondition is checked only when no events are available. NOTE: StopCondition should not assume that a document is bound. If all the process' windows are inactive, StopCondition will be called before the process is suspended (to give you a chance to regain control), but all the process' documents will be unbound. You can check for this situation by testing currentDocument for NIL.} {$S sStartup} PROCEDURE {TProcess.}ObeyEvents{(FUNCTION StopCondition: BOOLEAN)}; LABEL 9; VAR selection: TSelection; PROCEDURE StopTest; BEGIN IF StopCondition THEN BEGIN LetOthersRun; GOTO 9; END; END; PROCEDURE GetAndObeyEvent; LABEL 1; BEGIN {$IFC fTrace}BP(1);{$ENDC} GetEvent(event); {$IFC fDbgABC} IF fExperimenting and eventDebug THEN WITH event.who^.portRect DO BEGIN WriteLn('GetAndObeyEvent (event.who):', ORD(event.who)); WriteLn(left, top, right, bottom); WriteLn(event.where.h, event.where.v); END; {$ENDC} IF ImActive THEN IF SELF.AbortRequest THEN IF event.what IN [keyDown, buttonDown, buttonUp] THEN GOTO 1; SELF.ObeyTheEvent; 1: {$IFC fTrace}EP;{$ENDC} END; BEGIN {$IFC fTrace}BP(7);{$ENDC} {Shouldn't tell Filer initFailed after this} isInitialized := TRUE; {Main event loop} {NOTE: currentWindow <> NIL implies (1) process is active OR (2) process is running in the background and has a document } REPEAT WHILE NOT (ImActive OR amDying OR (currentWindow <> NIL)) DO BEGIN IF NOT EventAvail THEN StopTest; GetAndObeyEvent; {may suspend me} END; WHILE (ImActive OR (currentWindow <> NIL)) AND NOT amDying DO IF EventAvail THEN GetAndObeyEvent ELSE BEGIN StopTest; currentWindow.Update(TRUE); IF currentWindow.dialogBox <> NIL THEN currentWindow.dialogBox.Update(TRUE); IF NOT (amDying OR eventAvail) THEN BEGIN selection := currentWindow.selectWindow.selectPanel.selection; idleTime := Time; selection.IdleBegin(idleTime); WHILE NOT (amDying OR eventAvail) DO selection.IdleContinue(Time); IF NOT amDying THEN selection.IdleEnd(Time); END; END; UNTIL amDying; 9: {$IFC fTrace}EP;{$ENDC} END; {$S sStartup} PROCEDURE {TProcess.}ObeyFilerEvent; LABEL 1; TYPE {$IFC LibraryVersion <= 20} TFileOpKind = (fopNone, fopSuspend, fopSaveVersion); {$ELSEC} TFileOpKind = (fopNone, fopSuspend, fopSaveVersion, fopCopyDoc); {$ENDC} VAR reply: FReply; badReply: FReply; reason: FReason; window: TWindow; openAsTool: BOOLEAN; document: TDocManager; flrParams: FilerExt; flrOp: FilerOp; volumePrefix: TFilePath; wasSuspended: BOOLEAN; fileOpKind: TFileOpKind; doSuspend: BOOLEAN; doSave: BOOLEAN; error: INTEGER; PROCEDURE CheckAbort(abortReason: INTEGER); VAR i: INTEGER; dsPathname: PathName; BEGIN IF abortReason = 0 THEN IF SELF.AbortRequest THEN abortReason := erAborted ELSE Exit(CheckAbort); {$IFC fDbgABC} IF abortReason <> erAborted THEN BEGIN WriteLn('--------------------'); ReportFilerEvent(flrParams); ABCbreak('TProcess.ObeyFilerEvent got an error (event listed above)', abortReason); END; {$ENDC} IF (flrOp = fcResume) OR (flrOp = fcNone) THEN BEGIN IF window <> NIL THEN PopFocus; IF wasSuspended THEN { Close but don't kill the datasegs } BEGIN FOR i := 1 TO maxSegments DO IF document.dataSegment.refnum[i] >= 0 THEN BEGIN dsPathName := Concat(document.files.volumePrefix, suspendSuffix[i]); Close_DataSeg(error, document.dataSegment.refnum[i]); document.dataSegment.refnum[i] := -1; END END ELSE BEGIN { In case the BlankStationery method was called and opened any files } document.CloseFiles; { kill any data segments that were created } document.KillSegments(1, maxSegments); END; { delete from docList, IF there, and free regardless } docList.DelObject(document, TRUE); boundDocument := NIL; END; TellFiler(error, badReply, FilerReason(abortReason), event.who); GOTO 1; END; BEGIN {$IFC fTrace}BP(7);{$ENDC} wasSuspended := FALSE; GetAddParams(error, event, flrParams); IF error > 0 THEN ABCBreak('GetAddParams', error); flrOp := flrParams.theFlrOp; allowAbort := TRUE; {??? should we assume this ???} {$IFC fDbgABC} IF eventDebug THEN ReportFilerEvent(flrParams); {$ENDC} CASE flrOp OF fcNone, fcResume: BEGIN { The assumption for aborting here is things will, where possible, be cleaned up along the way by anyone detecting the abort. Things that have already happened after the abort is detected will be cleaned up in CheckAbort. The process will of course continue after the abort. } IF (inBackground) AND (doclist.size > 0) THEN TellFiler(error, docClosd, noMoreDocs, event.who) {No multiple doc's in background} ELSE BEGIN { Set badReply in case Abort is detected } badReply := docClosd; TakeWindow(event.who); WITH flrParams DO BEGIN openAsTool := flrOp = fcNone; IF openAsTool THEN thePrefix := CONCAT(toolVolume, toolPrefix); document := SELF.NewDocManager(thePrefix, openAsTool); {$IFC LibraryVersion > 20} document.files.password := thePassword; {$ENDC} END; IF document = NIL THEN {application refused the request} TellFiler(error, docClosd, noMoreDocs, event.who) ELSE BEGIN document.openedAsTool := openAsTool; SetPort(event.who); {so things like InvalRect in BlankStationery will work} { Returns Abort as error = erAborted } document.Open(error, ORD(event.who), wasSuspended); window := NIL; {so CheckAbort will not PopFocus} CheckAbort(error); PushFocus; window := document.window; window.Focus; window.Resize(FALSE); CheckAbort(0); InvalRect(window.innerRect); window.Update(TRUE); CheckAbort(0); PopFocus; IF event.who = activeFolder THEN {already active so we don't get a folderActivate} BEGIN PushFocus; window.Focus; {window.Activate assumes focused} currentDocument := document; {this must be set before calling TWindow.Activate} window.Activate; PopFocus; END ELSE window.StashPicture(hOffToDim); END; END; END; {fcNone/fcResume case} { The assumption for aborting here is things will be cleaned up along the way by anyone detecting the abort. The process will of course continue after the abort. } fcClose, fcSuspend, fcCopy, fcPut, fcShred: BEGIN {$IFC LibraryVersion <= 20} fileOpKind := fopNone; document := POINTER(GetFldrRefCon(event.who)); document.Bind; {$ELSEC} IF (flrOp = fcCopy) AND (Length(flrParams.theResult) > 0) THEN BEGIN fileOpKind := fopCopyDoc; document := NIL; END ELSE BEGIN fileOpKind := fopNone; document := POINTER(GetFldrRefCon(event.who)); document.Bind; END; {$ENDC} CASE flrOp OF fcClose, fcSuspend, fcShred: BEGIN IF flrOp = fcClose THEN BEGIN IF document.window.changes <> 0 THEN fileOpKind := fopSaveVersion; END ELSE fileOpKind := fopSuspend; volumePrefix := document.files.volumePrefix; reply := docClosd; badReply := docNotClosd; END; OTHERWISE {fcCopy, fcPut} BEGIN {$IFC LibraryVersion <= 20} fileOpKind := fopSaveVersion; {$ELSEC} IF fileOpKind <> fopCopyDoc THEN fileOpKind := fopSaveVersion; {$ENDC} volumePrefix := flrParams.thePrefix; reply := docXfered; badReply := docNotXfered; END; END; allowAbort := NOT doSuspend; {for now all ops can be aborted except fcSuspend and fcShred} CheckAbort(0); IF document <> NIL THEN document.ConserveMemory(0, TRUE {GC}); CheckAbort(0); CASE fileOpKind OF fopSuspend: IF document.files.shouldSuspend THEN document.Suspend(error); {*** we ignore the volumePrefix !!! ***} fopSaveVersion: IF document.files.shouldToolSave OR NOT document.openedAsTool THEN document.SaveVersion(error, volumePrefix, FALSE); {$IFC LibraryVersion > 20} fopCopyDoc: SELF.CopyExternalDoc(error, flrParams.theResult, volumePrefix); {$ENDC} END; { You cannot abort after SaveVersion or Suspend unless the abort was detected within SaveVersion or Suspend and indicated by their returned error being erAborted } IF error > 0 THEN IF flrOp = fcShred THEN BEGIN {try to close all files} document.CloseFiles; document.KillSegments(1, maxSegments); error := 0; {always give a good reply to the filer} END ELSE CheckAbort(error); TellFiler(error, reply, FilerReason(error), event.who); IF flrOp <> fcCopy THEN BEGIN closedDocument := document; closedBySuspend := doSuspend; END; allowAbort := TRUE; END; fcDfClose: BEGIN badReply := dfNotClosed; Close_Object(error, flrParams.theDf); CheckAbort(error); TellFiler(error, dfClosed, allOk, event.who); END; fcTerminate: amDying := TRUE; END; 1: {$IFC fTrace}EP;{$ENDC} END; {$S sStartup} PROCEDURE {TProcess.}ObeyTheEvent; {NOTE: For the duration of the event, we are focused on the eventWindow} VAR eventDocument: TDocManager; eventWindow: TWindow; dialogBox: TDialogBox; paused: BOOLEAN; pkEvent: EventRecord; {$IFC fCheckHeap} numObjects: INTEGER; docHeap: THeap; {$ENDC} FUNCTION EvtWindow(VAR evt: EventRecord): TWindow; BEGIN {$IFC fTrace}BP(1);{$ENDC} EvtWindow := eventDocument.WindowWithId(ORD(evt.who)); IF evt.what = keyDown THEN BEGIN dialogBox := currentWindow.dialogBox; IF dialogBox <> NIL THEN IF dialogBox.keyResponse = diDismissDialogBox THEN dialogBox.BeDismissed ELSE {+SW+} IF (dialogBox.keyResponse = diAccept) AND (currentWindow.selectWindow = dialogBox) THEN EvtWindow := dialogBox END; {$IFC fTrace}EP;{$ENDC} END; BEGIN {$IFC fTrace}BP(7);{$ENDC} eventTime := event.when; eventType := event.what; {$IFC fDbgABC} IF eventDebug THEN ReportEvent; {$ENDC} WITH event DO IF what = buttonUp THEN ELSE IF what = filerEvent THEN SELF.ObeyFilerEvent ELSE IF who <> alertFolder THEN BEGIN IF what = folderActivate THEN TakeControl(event, FALSE, FALSE); eventDocument := currentDocument; IF who = menuFolder THEN {much changed} BEGIN eventWindow := currentWindow; dialogBox := currentWindow.dialogBox; IF dialogBox <> NIL THEN IF dialogBox.menuResponse = diDismissDialogBox THEN dialogBox.BeDismissed ELSE IF dialogBox.menuResponse = diAccept THEN eventWindow := currentWindow.selectWindow; {+SW+} END ELSE IF who = dialogFolder THEN eventWindow := currentWindow.dialogBox ELSE IF who = scrapFolder THEN BEGIN eventDocument := clipboard; clipboard.Bind; eventWindow := clipboard.window; END ELSE IF who = NIL THEN {assuming that we cannot receive a private event directed towards a particular window} BEGIN eventWindow := NIL; process.HandlePrivateEvent(what, fromProcess, when, userData); END ELSE BEGIN eventDocument := POINTER(GetFldrRefCon(who)); IF eventDocument = NIL THEN BEGIN ABCBreak('GetFldrRefCon = NIL', ORD(who)); eventWindow := NIL; END ELSE BEGIN eventDocument.Bind; eventWindow := EvtWindow(event); END; END; IF eventWindow <> NIL THEN BEGIN PushFocus; IF who = menuFolder THEN eventWindow.Focus ELSE BEGIN SetPort(event.who); {$IFC fDbgABC} IF fExperimenting and eventDebug THEN WITH thePort^.portRect DO BEGIN WriteLn('Before LocalToGlobal (thePort):', ORD(thePort)); WriteLn(left, top, right, bottom); WriteLn(where.h, where.v); END; {$ENDC} LocalToGlobal(where); eventWindow.Focus; {$IFC fDbgABC} IF fExperimenting and eventDebug THEN WITH thePort^.portRect DO BEGIN WriteLn('Before GlobalToLocal (thePort):', ORD(thePort)); WriteLn(left, top, right, bottom); WriteLn(where.h, where.v); END; {$ENDC} GlobalToLocal(where); {$IFC fDbgABC} IF fExperimenting and eventDebug THEN WITH thePort^.portRect DO BEGIN WriteLn('After GlobalToLocal (thePort):', ORD(thePort)); WriteLn(left, top, right, bottom); WriteLn(where.h, where.v); END; {$ENDC} END; IF deferUpdate THEN IF (what <> keyDown) OR appleKey THEN eventWindow.Update(TRUE); deferUpdate := FALSE; CASE what OF abortEvent: eventWindow.AbortEvent; buttonDown: IF who = menuFolder THEN eventWindow.MenuEventAt(where) ELSE eventWindow.DownEventAt(where); folderActivate: BEGIN currentDocument := eventDocument; eventWindow.Activate; END; folderDeactivate: eventWindow.Deactivate; folderMoved: BEGIN eventWindow.Resize(TRUE); process.RememberCommand(uMoveWindow); END; folderUpdate: eventWindow.Update(TRUE); keyDown: IF eventWindow.selectPanel = NIL THEN {$IFC fDbgABC} ABCBreak('ObeyTheEvent: selectPanel=NIL', 0) {$ENDC} ELSE REPEAT eventWindow.selectPanel.selection.DoKey(ascii, keyCap, shiftKey, appleKey, codeKey); IF PeekEvent(pkEvent) THEN paused := (ImActive AND SELF.AbortRequest) OR (eventWindow <> EvtWindow(pkEvent)) OR (pkEvent.what <> keyDown) OR ((pkEvent.what = keyDown) AND (pkEvent.AppleKey)) {LSR} ELSE paused := TRUE; IF NOT paused THEN BEGIN GetEvent(event); eventTime := event.when; eventType := event.what; {$IFC fDbgABC} IF eventDebug THEN ReportEvent; {$ENDC} END ELSE IF eventWindow.selectPanel <> NIL THEN eventWindow.selectPanel.selection.KeyPause; UNTIL paused; END; IF (closedDocument = NIL) AND (currentWindow <> NIL) THEN BEGIN {+SW+} IF NOT deferUpdate THEN BEGIN IF currentWindow.dialogBox <> NIL THEN currentWindow.dialogBox.Update(TRUE); currentWindow.Update(TRUE); END; IF currentWindow.objectToFree <> NIL THEN {+SW+} BEGIN currentWindow.objectToFree.Free; currentWindow.objectToFree := NIL END; END; PopFocus; END; END; IF closedDocument <> NIL THEN BEGIN closedDocument.Close(closedBySuspend); closedDocument.Free; closedDocument := NIL; END; process.BindCurrentDocument; {This also unbinds the eventDocument, in the case where we got an event while inactive.} {$IFC fCheckHeap AND fDbgABC} IF fCountHeap AND (event.what <> buttonUp) THEN BEGIN numObjects := CountHeap(mainHeap); Write('mainHeap has ', numObjects:1, ' objects'); IF boundDocument <> NIL THEN BEGIN docHeap := boundDocument.docHeap; IF docHeap <> NIL THEN BEGIN numObjects := CountHeap(docHeap); Write('; boundDocument heap has ', numObjects:1, ' objects'); MarkHeap(docHeap, ORD(boundDocument.dataSegment.preludePtr^.docDirectory)); SweepHeap(docHeap, TRUE); END; END; IF boundClipboard <> NIL THEN BEGIN docHeap := boundClipboard.docHeap; IF docHeap <> NIL THEN BEGIN numObjects := CountHeap(docHeap); Write('; boundClipboard heap has ', numObjects:1, ' objects'); END; END; WriteLn; END; {$ENDC} {$IFC fDebugMethods} IF docList.Size = 0 THEN SELF.DontDebug; {$ENDC} {$IFC fTrace}EP;{$ENDC} END; {$S sError} FUNCTION {TProcess.}Phrase{(error: INTEGER)}; VAR erStr: S255; BEGIN {$IFC fTrace}BP(5);{$ENDC} {client can override} {also, I should case on os error codes} CASE error OF erAborted : Phrase := phTerminated; OTHERWISE BEGIN {$IFC fTrace} (** SuErrText('OSERRS.ERR', error, @erStr); **) Writeln; Writeln('Error # ', error, '; ', erStr); {$ENDC} Phrase := phUnknown; END; END; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCcld} PROCEDURE {TProcess.}HandlePrivateEvent(typeOfEvent: INTEGER; fromProcess: LONGINT; when: LONGINT; otherData: LONGINT); BEGIN {$IFC fTrace}BP(7);{$ENDC} {$IFC fTrace}EP;{$ENDC} END; {$S sRes} PROCEDURE {TProcess.}RememberCommand{(cmdNumber: TCmdNumber)}; LABEL 1; PROCEDURE CallWouldAlert(VAR menu: MenuInfo; itemIndex: INTEGER); BEGIN WouldAlert(menu, itemIndex); GOTO 1; END; BEGIN {$IFC fTrace}BP(5);{$ENDC} IF NOT menubar.GetCmdName(cmdNumber, NIL) THEN cmdNumber := uSomeCommand; InAllMenusDo(TRUE, cmdNumber, CallWouldAlert); InAllMenusDo(FALSE, cmdNumber, CallWouldAlert); 1: {$IFC fTrace}EP;{$ENDC} END; {$S sStartup} PROCEDURE {TProcess.}Run; FUNCTION UntilPowerOff: BOOLEAN; BEGIN UntilPowerOff := FALSE; END; BEGIN {$IFC fTrace}BP(7);{$ENDC} SELF.ObeyEvents(UntilPowerOff); {$IFC fTrace}EP;{$ENDC} END; {$S SgABCcld} PROCEDURE {TProcess.}SendEvent(typeOfEvent: INTEGER; targetProcess: LONGINT; otherData: LONGINT); VAR er: EventRecord; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF typeOfEvent < firstPrivateEvent THEN BEGIN {$IFC fDbgABC} ABCbreak('Invalid event type passed to TProcess.SendEvent', typeOfEvent); {$ENDC} END ELSE BEGIN WITH er DO BEGIN who := NIL; {can't tell what window we are sending to} what := typeOfEvent; when := Time; toProcess := targetProcess; fromProcess := myProcessID; userData := otherData; END; SendEvent(er, targetProcess); END; {$IFC fTrace}EP;{$ENDC} END; {$S sAlert} PROCEDURE {TProcess.}Stop{(phraseNumber: INTEGER)}; {$IFC LibraryVersion > 20} VAR dummy: INTEGER; {$ENDC} BEGIN {$IFC fTrace}BP(7);{$ENDC} ArgAlert(0, toolName); {$IFC LibraryVersion > 20} IF activeWindowID = 0 THEN dummy := BackgroundAlert(alerts, phraseNumber, StopProc) ELSE {$ENDC} StopAlert(alerts, phraseNumber); {$IFC fTrace}EP;{$ENDC} END; {$S sStartup} PROCEDURE {TProcess.}TrackCursor; { assumes we are active; can't track the cursor if not } VAR cursorNumber: TCursorNumber; BEGIN {$IFC fTrace}BP(3);{$ENDC} cursorNumber := noCursor; IF currentWindow.dialogBox <> NIL THEN BEGIN cursorNumber := currentWindow.dialogBox.CursorFeedback; IF cursorNumber = noCursor THEN IF currentWindow.dialogBox.downInMainWindowResponse = diRefuse THEN {was cantDown} cursorNumber := arrowCursor; END; IF cursorNumber = noCursor THEN cursorNumber := currentWindow.CursorFeedback; IF cursorNumber = noCursor THEN cursorNumber := arrowCursor; SELF.ChangeCursor(cursorNumber); {$IFC fTrace}EP;{$ENDC} END; {$S SgABCini} BEGIN UnitAuthor('Apple'); InitProcess; END; METHODS OF TDocDirectory; {$S SgABCini} FUNCTION {TDocDirectory.}CREATE{(object: TObject; heap: THeap; itsWindow: TWindow; itsClassWorld: TClassWorld): TDocDirectory}; VAR world: TClassWorld; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF object = NIL THEN object := NewObject(heap, THISCLASS); SELF := TDocDirectory(object); WITH world DO BEGIN infRecs := TArray(itsClassWorld.infRecs.Clone(heap)); classes := TArray(itsClassWorld.classes.Clone(heap)); (*^*) authors := TArray(itsClassWorld.authors.Clone(heap)); (*^*) aliases := TArray(itsClassWorld.aliases.Clone(heap)); (*^*) END; WITH SELF DO BEGIN window := itsWindow; classWorld := world; END; {$IFC fTrace}EP;{$ENDC} END; {$IFC fDebugMethods} {$S SgABCdbg} PROCEDURE {TDocDirectory.}Fields{(PROCEDURE Field(nameAndType: S255))}; BEGIN Field('window: TWindow'); Field('classList: TList'); END; {$ENDC} {$S SgABCcld} PROCEDURE {TDocDirectory.}Adopt; (*^*) VAR world: TClassWorld; heap: THeap; BEGIN {$IFC fMaxTrace}BP(1);{$ENDC} {$IFC fMaxTrace}EP;{$ENDC} heap := SELF.Heap; world := SELF.classWorld; WITH world DO BEGIN infRecs.Free; classes.Free; authors.Free; aliases.Free; infRecs := TArray(myWorld.infRecs.Clone(heap)); classes := TArray(myWorld.classes.Clone(heap)); authors := TArray(myWorld.authors.Clone(heap)); aliases := TArray(myWorld.aliases.Clone(heap)); END; SELF.classWorld := world; END; {$S SgABCini} END; METHODS OF TDocManager; {$S SgABCini} FUNCTION {TDocManager.}CREATE{(object: TObject; heap: THeap; itsPathPrefix: TFilePath): TDocManager}; VAR itsVolume: TFilePath; itsFile: TFilePath; i: INTEGER; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF object = NIL THEN object := NewObject(heap, THISCLASS); SELF := TDocManager(object); SplitFilePath(itsPathPrefix, itsVolume, itsFile); WITH SELF.files DO BEGIN volumePrefix := itsPathPrefix; volume := itsVolume; {$IFC LibraryVersion > 20} password := ''; {$ENDC} shouldSuspend := TRUE; shouldToolSave := FALSE; END; WITH SELF.dataSegment DO BEGIN preludePtr := NIL; FOR i := 1 TO maxSegments DO refnum[i] := -1; changes := 0; END; WITH SELF DO BEGIN window := NIL; pendingNote := 0; docHeap := NIL; END; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$IFC fDebugMethods} {$S SgABCdbg} PROCEDURE {TDocManager.}Fields{(PROCEDURE Field(nameAndType: S255))}; BEGIN (* TFilePath = STRING[255]; maxSegments = 6 *) Field(CONCAT('files: RECORD volumePrefix: STRING[255]; volume: STRING[255]; password: STRING[32];', 'saveExists: BOOLEAN; shouldSuspend: BOOLEAN; shouldToolSave: BOOLEAN; END')); Field('dataSegment: RECORD refnum: ARRAY [1..6] OF INTEGER; preludePtr: Ptr; changes: LONGINT; END'); Field('docHeap: Ptr'); Field('window: TWindow'); Field('pendingNote: INTEGER'); Field('openedAsTool: BOOLEAN'); Field(''); END; {$S SgABCres} {$ENDC} {$S SgABCcld} PROCEDURE {TDocManager.}Assimilate{(VAR error: INTEGER)}; VAR hz: THz; exDocDirectory: TDocDirectory; exClasses: TClassWorld; doConvert: BOOLEAN; olderVersion: BOOLEAN; newerVersion: BOOLEAN; BEGIN {$IFC fTrace}BP(7);{$ENDC} hz := POINTER(ORD(SELF.docHeap)); hz^.procCbMore := @ExpandHeap; {The code address may have changed} error := 0; WITH SELF.dataSegment.preludePtr^ DO BEGIN exDocDirectory := docDirectory; exClasses := exDocDirectory.classWorld; IF password <> 25376 THEN {***temporary***} error := erPassword; END; (**) IF error <= 0 THEN IF NeedConversion(exClasses, olderVersion, newerVersion) THEN BEGIN IF newerVersion THEN doConvert := process.Caution(phNewerVersion) ELSE IF olderVersion THEN doConvert := process.Caution(phOlderVersion) ELSE doConvert := TRUE; IF doConvert THEN BEGIN process.BeginWait(phConverting); allowAbort := FALSE; {cannot abort the conversion} ConvertHeap(SELF.docHeap, exClasses); exDocDirectory.Adopt; (*^*) SELF.ConserveMemory(docExcess, TRUE {GC}); allowAbort := TRUE; process.EndWait; END ELSE error := erVersion; END; (**) {$IFC fTrace}EP;{$ENDC} END; {$S sStartup} PROCEDURE {TDocManager.}Bind; VAR i: INTEGER; error: INTEGER; sched_err: INTEGER; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF boundDocument <> SELF THEN BEGIN IF boundDocument <> NIL THEN boundDocument.Unbind; i := 1; {We must bind segment #1 before we can find out numSegments} REPEAT Sched_Class(sched_err, FALSE); Bind_DataSeg(error, SELF.dataSegment.refnum[i]); Sched_Class(sched_err, TRUE); IF error > 0 THEN ABCBreak('Bind_DataSeg', error); i := i + 1; UNTIL i > SELF.dataSegment.preludePtr^.numSegments; boundDocument := SELF; END; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCcld} PROCEDURE {TDocManager.}Close{(afterSuspend: BOOLEAN)}; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF SELF = currentDocument THEN BEGIN currentDocument := NIL; currentWindow := NIL; activeWindowID := 0; END; IF NOT afterSuspend THEN SELF.KillSegments(1, maxSegments); docList.DelObject(SELF, FALSE); IF SELF = boundDocument THEN boundDocument := NIL; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S SgABCcld} PROCEDURE {TDocManager.}CloseFiles; BEGIN {$IFC fTrace}BP(7);{$ENDC} { For the application to override IF it needs to close any of its own files } {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S SgABCini} PROCEDURE {TDocManager.}Complete{(allIsWell: BOOLEAN)}; BEGIN {$IFC fTrace}BP(7);{$ENDC} {**** Try to save the document, code needed here. ****} {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S SgABCcld} PROCEDURE {TDocManager.}ConserveMemory{(maxExcess: LONGINT; fGC: BOOLEAN)}; VAR heap: THeap; hz: THz; bytesReduced: LONGINT; error: INTEGER; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF SELF <> clipboard THEN BEGIN heap := SELF.docHeap; IF fGC THEN BEGIN MarkHeap(heap, ORD(SELF.dataSegment.preludePtr^.docDirectory)); {$IFC fDbgABC} SweepHeap(heap, TRUE); {Report garbage} {$ELSEC} SweepHeap(heap, FALSE); {Free garbage} {$ENDC} END; hz := POINTER(ORD(heap)); REPEAT bytesReduced := CbShrinkHz(hz, maxSegSize) UNTIL bytesReduced < maxSegSize; SELF.SetSegSize(error, CbOfHz(hz) + SELF.dataSegment.preludePtr^.preludeSize, maxExcess); IF error > 0 THEN process.Complete(FALSE); END; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S SgABCcld} PROCEDURE {TDocManager.}Deactivate; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF SELF = currentDocument THEN BEGIN currentWindow := NIL; currentDocument := NIL; {so we can unbind the document} END; allowAbort := FALSE; SELF.ConserveMemory(docExcess, FALSE {no GC}); allowAbort := TRUE; SELF.Unbind; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S SgABCini} FUNCTION {TDocManager.}DfltHeapSize{: LONGINT}; BEGIN {$IFC fTrace}BP(3);{$ENDC} DfltHeapSize := docDsBytes; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$IFC fDbgABC} {$S SgABCdbg} PROCEDURE {TDocManager.}DumpPrelude; VAR preludePtr: TPPrelude; {needed so WITH doesn't complain about $H+} PROCEDURE AbortDumpVar(pVariable: Ptr; nameAndType: S255); BEGIN IF CheckKeyPress('Document prelude dump') THEN BEGIN WriteLn; WriteLn; Exit(DumpPrelude); END; DumpVar(pVariable, nameAndType); END; BEGIN WriteLn; WriteLn('--- PRELUDE OF THE DOCUMENT ---'); WriteLn; preludePtr := SELF.dataSegment.preludePtr; WITH preludePtr^ DO BEGIN AbortDumpVar(@password, 'password: INTEGER'); AbortDumpVar(@version, 'version: INTEGER'); AbortDumpVar(@country, 'country: INTEGER'); AbortDumpVar(@language, 'language: INTEGER'); AbortDumpVar(@preludeSize, 'preludeSize: INTEGER'); AbortDumpVar(@docSize, 'docSize: LONGINT'); AbortDumpVar(@numSegments, 'numSegments: INTEGER'); AbortDumpVar(@docDirectory, 'docDirectory: TDocDirectory'); END; WriteLn; WriteLn; END; {$S SgABCres} {$ENDC} {$S sCldInit} PROCEDURE {TDocManager.}ExpandMemory{(bytesNeeded: LONGINT)}; VAR error: INTEGER; BEGIN {$IFC fTrace}BP(7);{$ENDC} SELF.SetSegSize(error, SELF.dataSegment.preludePtr^.docSize + bytesNeeded, docExcess); IF error > 0 THEN process.Complete(FALSE); {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S SgABCcld} PROCEDURE {TDocManager.}KillSegments{(first, last: INTEGER)}; VAR i: INTEGER; dsPathname: PathName; {$IFC LibraryVersion > 20} dsPassword: E_Name; blankPasswd: E_Name; {$ENDC} error: INTEGER; BEGIN {$IFC fTrace}BP(7);{$ENDC} error := 0; {$IFC LibraryVersion > 20} dsPassword := SELF.files.password; blankPasswd := ''; {$ENDC} FOR i := first TO last DO IF SELF.dataSegment.refnum[i] >= 0 THEN BEGIN dsPathName := CONCAT(SELF.files.volumePrefix, suspendSuffix[i]); {$IFC LibraryVersion > 20} Change_Password(error, dsPathname, dsPassword, blankPasswd); {$ENDC} Kill_DataSeg(error, dsPathname); Close_DataSeg(error, SELF.dataSegment.refnum[i]); SELF.dataSegment.refnum[i] := -1; END; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S sCldInit} PROCEDURE {TDocManager.}MakeSegments{(VAR error: INTEGER; oldSegments: INTEGER; newDocSize: LONGINT)}; TYPE TempType = ARRAY [1..MAXINT] OF Byte; PTempType = ^TempType; VAR currDocSize: LONGINT; newSegments: INTEGER; i: INTEGER; ldsn: INTEGER; thisSegSize: LONGINT; dsPathname: PathName; dsRefnum: INTEGER; memOrd: LONGINT; dsInfo: DsInfoRec; newSize: LONGINT; p: PTempType; {$IFC LibraryVersion > 20} dsPassword: E_Name; blankPasswd: E_Name; {$ENDC} sched_err: INTEGER; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF (boundDocument <> NIL) AND ((boundDocument <> SELF) OR (oldSegments = 0)) THEN boundDocument.Unbind; {*** This may be dispensable ***} error := 0; IF (oldSegments > 0) THEN BEGIN {expand the current last data segment out to maxSegSize; we assume that the caller has already checked that a new segment is actually needed} dsRefnum := SELF.dataSegment.refnum[oldSegments]; Info_DataSeg(error, dsRefnum, dsInfo); IF error <= 0 THEN BEGIN Sched_Class(sched_err, FALSE); Size_DataSeg(error, dsRefnum, maxSegSize - dsInfo.mem_size, newSize, maxSegSize - dsInfo.disc_size, newSize); Sched_Class(sched_err, TRUE); END ELSE ABCbreak('In MakeSegments, error from Info_Dataseg', error); END; currDocSize := oldSegments*maxSegSize; newSegments := oldSegments; {$IFC LibraryVersion > 20} dsPassword := SELF.files.password; blankPasswd := ''; {$ENDC} WHILE (currDocSize < newDocSize) AND (error <= 0) DO BEGIN newSegments := newSegments + 1; ldsn := newSegments + docLdsn-1; thisSegSize := Min(newDocSize - currDocSize, maxSegSize); thisSegSize := LIntMulInt(LIntDivInt(thisSegSize + 511, 512), 512); dsPathname := CONCAT(SELF.files.volumePrefix, suspendSuffix[newSegments]); {$IFC LibraryVersion > 20} Change_Password(error, dsPathname, dsPassword, blankPasswd); {$ENDC} Open_Dataseg(error, dsPathname, dsRefnum, memOrd, ldsn); {$IFC fDbgABC} IF error > 0 THEN WriteLn('In TDocManager.MakeSegments: error from Open_Dataseg=', error:1); {$ENDC} IF error > 0 THEN BEGIN Sched_Class(sched_err, FALSE); Make_Dataseg(error, dsPathname, thisSegSize, thisSegSize, dsRefnum, memOrd, ldsn, ds_shared); Sched_Class(sched_err, TRUE); END ELSE BEGIN SetAccess_DataSeg(error, dsRefnum, FALSE); {Make writeable} IF error <= 0 THEN BEGIN Info_DataSeg(error, dsRefnum, dsInfo); IF error <= 0 THEN BEGIN Sched_Class(sched_err, FALSE); Size_DataSeg(error, dsRefnum, thisSegSize - dsInfo.mem_size, newSize, thisSegSize - dsInfo.disc_size, newSize); Sched_Class(sched_err, TRUE); END; END; END; IF error > 0 THEN ABCBreak('In TDocManager.MakeSegments: Make_Dataseg', error) ELSE BEGIN {$IFC LibraryVersion > 20} Change_Password(error, dsPathname, blankPasswd, dsPassword); IF error > 0 THEN ABCBreak('In TDocManager.MakeSegments: Change_Password', error); {$ENDC} SELF.dataSegment.refnum[newSegments] := dsRefnum; IF ldsn = docLdsn THEN p := POINTER(memOrd); END; currDocSize := currDocSize + thisSegSize; IF process.AbortRequest THEN error := erAborted; END; IF error <= 0 THEN WITH SELF.dataSegment DO BEGIN IF oldSegments = 0 THEN BEGIN boundDocument := SELF; FOR i := 1 TO SIZEOF(TPrelude) DO p^[i] := 0; preludePtr := POINTER(ORD(p)); END; preludePtr^.docSize := currDocSize; preludePtr^.numSegments := newSegments; END; {$IFC fTrace}EP;{$ENDC} END; {$S Override} FUNCTION {TDocManager.}NewWindow{(heap: THeap; wmgrID: TWindowID): TWindow}; BEGIN {$IFC fTrace}BP(7);{$ENDC} NewWindow := TWindow.CREATE(NIL, heap, wmgrID, TRUE); {$IFC fTrace}EP;{$ENDC} END; {$S sCldInit} PROCEDURE {TDocManager.}Open{(VAR error: INTEGER; wmgrID: TWindowID; VAR openedSuspended: BOOLEAN)}; LABEL 1; VAR aFile: TFile; volumePrefix: TFilePath; pWindow: WindowPtr; window: TWindow; BEGIN {$IFC fTrace}BP(7);{$ENDC} openedSuspended := FALSE; volumePrefix := SELF.files.volumePrefix; IF SELF.files.shouldToolSave OR NOT SELF.openedAsTool THEN BEGIN aFile := TFile.CREATE(NIL, mainHeap, volumePrefix, ''); {Look for the save file} IF NOT aFile.Exists(error) THEN BEGIN aFile.Become(TFile.CREATE(NIL, mainHeap, CONCAT(volumePrefix, '$T'), '')); IF aFile.Exists(error) THEN aFile.Rename(error, volumePrefix); END; aFile.Free; SELF.files.saveExists := error <= 0; END ELSE SELF.files.saveExists := FALSE; IF process.AbortRequest THEN BEGIN error := erAborted; GOTO 1; END; {Try to open suspend files first, THEN the save file, THEN blank stationery} IF SELF.files.shouldSuspend THEN SELF.OpenSuspended(error, wmgrID) ELSE {don't even try the suspend file} error := erNameNotFound; IF error > 0 THEN IF error <> erAborted THEN IF SELF.files.saveExists THEN {won't even try this if we don't create save files} SELF.OpenSaved(error, wmgrID) ELSE SELF.OpenBlank(error, wmgrID) ELSE openedSuspended := TRUE ELSE openedSuspended := TRUE; IF error <= 0 THEN BEGIN SELF.dataSegment.changes := 0; window := SELF.dataSegment.preludePtr^.docDirectory.window; SELF.window := window; window.SetWmgrId(wmgrID); {changes the wmgrId of the window and the port of the panes} pWindow := POINTER(wmgrID); SetFldrRefCon(pWindow, ORD(SELF)); docList.InsLast(SELF); END ELSE IF NOT openedSuspended THEN SELF.KillSegments(1, maxSegments); {*** Good idea?} 1: {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S sCldInit} PROCEDURE {TDocManager.}OpenBlank{(VAR error: INTEGER; wmgrID: TWindowID)}; LABEL 1; VAR heapSize: LONGINT; heapStart: LONGINT; docHeap: THeap; prPrfAlias: TPrPrfAlias; objCount: INTEGER; docWindow: TWindow; docDirectory: TDocDirectory; PROCEDURE CheckAbort; BEGIN IF process.AbortRequest THEN BEGIN error := erAborted; GOTO 1; END; END; BEGIN {$IFC fTrace}BP(7);{$ENDC} heapSize := SELF.DfltHeapSize; SELF.MakeSegments(error, 0, heapSize + SIZEOF(TPrelude)); IF error <= 0 THEN BEGIN heapStart := ORD(SELF.dataSegment.preludePtr) + SIZEOF(TPrelude); docHeap := POINTER(ORD(HzInit(POINTER(heapStart), POINTER(heapStart+heapSize), NIL, LIntDivInt(heapSize, 10), 0, @ExpandHeap, POINTER(procNil), POINTER(procNil), POINTER(procNil)))); {*** DANGER ***} {@ExpandHeap is a pointer outside the data segment} {TDocManager.Assimilate must guarantee its accuracy} CheckAbort; PrPrfDefault(prPrfAlias.prPrf); WITH SELF.dataSegment.preludePtr^ DO BEGIN password := 25376; {*** temporary ***} version := 1; {*** should be this software's version ***} country := countryCode; language := countryCode; {*** same as country code? ***} preludeSize := SIZEOF(TPrelude); printPref := prPrfAlias.reserve; END; SELF.docHeap := docHeap; docWindow := SELF.NewWindow(docHeap, wmgrID); docDirectory := TDocDirectory.CREATE(NIL, docHeap, docWindow, myWorld); SELF.dataSegment.preludePtr^.docDirectory := docDirectory; docWindow.BlankStationery; CheckAbort; {$IFC fDbgABC} (* docWindow.CheckPanels;*** Should check that union of panel rects = window rect ***) {$ENDC} END; 1: {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S SgABCcld} PROCEDURE {TDocManager.}OpenSaved{(VAR error: INTEGER; wmgrID: TWindowID)}; VAR volumePrefix: TFilePath; aFile: TFile; fs: TFileScanner; fileSize: LONGINT; preludePtr: TPPrelude; BEGIN {$IFC fTrace}BP(7);{$ENDC} volumePrefix := SELF.files.volumePrefix; {$IFC LibraryVersion <= 20} aFile := TFile.CREATE(NIL, mainHeap, volumePrefix, ''); {$ELSEC} aFile := TFile.CREATE(NIL, mainHeap, volumePrefix, SELF.files.password); {$ENDC} fs := aFile.ScannerFrom(0, [fRead]); error := fs.error; IF error <= 0 THEN BEGIN fileSize := aFile.size; SELF.MakeSegments(error, 0, fileSize); IF error <= 0 THEN BEGIN preludePtr := SELF.dataSegment.preludePtr; process.AbortXferSequential(xRead, POINTER(ORD(preludePtr)), fileSize, abortChunkSize, fs); error := fs.error; IF error <= 0 THEN SELF.ResumeAfterOpen(error, wmgrID); preludePtr^.docDirectory.window.changes := 0; END; fs.Free; {Close the file & free the TFile object} END; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S SgABCini} PROCEDURE {TDocManager.}OpenSuspended{(VAR error: INTEGER; wmgrID: TWindowID)}; VAR volumePrefix: TFilePath; i: INTEGER; ldsn: INTEGER; dsPathname: PathName; dsRefnum: INTEGER; memOrd: LONGINT; preludePtr: TPPrelude; cease: BOOLEAN; {$IFC LibraryVersion > 20} dsPassword: E_Name; blankPasswd: E_Name; {$ENDC} otherError: INTEGER; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF boundDocument <> NIL THEN boundDocument.Unbind; volumePrefix := SELF.files.volumePrefix; {$IFC LibraryVersion > 20} dsPassword := SELF.files.password; blankPasswd := ''; {$ENDC} {loop invariant: i = # datasegs already bound + 1} i := 1; REPEAT ldsn := i + docLdsn-1; dsPathname := CONCAT(volumePrefix, suspendSuffix[i]); IF currentDocument <> NIL THEN {*** Get around OS anomaly ***} error := 313 {*** What it should return for Revert ***} ELSE {*** Remove these lines when fixed ***} BEGIN {$IFC LibraryVersion > 20} Change_Password(error, dsPathname, dsPassword, blankPasswd); {$ENDC} Open_DataSeg(error, dsPathname, dsRefnum, memOrd, ldsn); END; IF error <= 0 THEN BEGIN SELF.dataSegment.refnum[i] := dsRefnum; IF ldsn = docLdsn THEN preludePtr := POINTER(memOrd); SetAccess_DataSeg(error, dsRefnum, FALSE); {Make writeable} IF error > 0 THEN ABCBreak('In TDocManager.OpenSuspended: SetAccess_DataSeg', error); {$IFC LibraryVersion > 20} Change_Password(error, dsPathname, blankPasswd, dsPassword); IF error > 0 THEN ABCBreak('In TDocManager.OpenSuspended: Change_Password', error); {$ENDC} i := i + 1; END; IF process.AbortRequest THEN error := erAborted; IF error > 0 THEN cease := TRUE ELSE cease := i > preludePtr^.numSegments; UNTIL cease; IF error <= 0 THEN BEGIN SELF.dataSegment.preludePtr := preludePtr; boundDocument := SELF; SELF.ResumeAfterOpen(error, wmgrID); END ELSE WHILE i > 1 DO {back out by unbinding the datasegs} BEGIN i := i - 1; Unbind_Dataseg(otherError, SELF.dataSegment.refnum[i]); {$IFC fDbgABC} IF otherError > 0 THEN WriteLn(CHR(7), 'Error unbinding dataseg=', otherError:1); {$ENDC} SELF.dataSegment.refnum[i] := -1; END; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S SgABCcld} PROCEDURE {TDocManager.}ResumeAfterOpen{(VAR error: INTEGER; wmgrID: TWindowID)}; VAR preludePtr: TPPrelude; docHeap: THeap; objCount: INTEGER; BEGIN {$IFC fTrace}BP(1);{$ENDC} error := 0; preludePtr := SELF.dataSegment.preludePtr; docHeap := POINTER(ORD(preludePtr) + preludePtr^.preludeSize); SELF.docHeap := docHeap; SELF.Assimilate(error); (***** IF NOT fCheckHzOK(POINTER(ORD(docHeap)), objCount) THEN BEGIN ABCBreak('fCheckHzOK failed on suspend file: objCount', objCount); error := erInternal; END ELSE BEGIN SELF.docHeap := docHeap; SELF.Assimilate(error); END; *****) {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S SgABCcld} PROCEDURE {TDocManager.}RevertVersion{(VAR error: INTEGER; wmgrID: TWindowID)}; { for now, must be the active window to do this } VAR dontCare: BOOLEAN; BEGIN {$IFC fTrace}BP(1);{$ENDC} error := 0; SELF.Close(FALSE); { active/current Window/Document should have been made NIL by SELF.Close } currentDocument := SELF; {We could be cleverer and reuse the old data segments, later****} allowAbort := FALSE; {no abort allowed during revert} SELF.Open(error, wmgrID, dontCare); allowAbort := TRUE; IF error > 0 THEN BEGIN {$IFC fDbgABC} ABCBreak('RevertVersion error opening document', error); {$ENDC} END ELSE BEGIN PushFocus; currentWindow := SELF.window; activeWindowID := currentWindow.wmgrID; currentWindow.Focus; currentWindow.Resize(FALSE); InvalRect(currentWindow.innerRect); currentWindow.Update(TRUE); PopFocus; END; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S SgABCcld} PROCEDURE {TDocManager.}SaveVersion{(VAR error: INTEGER; volumePrefix: TFilePath; andContinue: BOOLEAN)}; VAR tmpFile: TFile; fs: TFileScanner; saveFile: TFile; localError: INTEGER; BEGIN {$IFC fTrace}BP(7);{$ENDC} error := 0; SELF.dataSegment.preludePtr^.docDirectory.window := SELF.window; {Just in case it somehow changed} IF NOT andContinue THEN {*** Revert to one pane per panel scrolled to the beginning & no (or standard) selection***}; IF process.AbortRequest THEN error := erAborted ELSE BEGIN {SELF.ReleaseDiskSpace...; *** TO DO **ONLY IF** WE CAN'T GET ENOUGH SPACE WITHOUT ***} IF process.AbortRequest THEN error := erAborted ELSE BEGIN {$IFC LibraryVersion <= 20} tmpFile := TFile.CREATE(NIL, mainHeap, CONCAT(volumePrefix, '$T'), ''); {$ELSEC} tmpFile := TFile.CREATE(NIL, mainHeap, CONCAT(volumePrefix, '$T'), SELF.files.password); {$ENDC} fs := tmpFile.ScannerFrom(0, [fWrite]); error := fs.error; IF error <= 0 THEN IF process.AbortRequest THEN error := erAborted; IF error > 0 THEN BEGIN tmpFile.Delete(localError); fs.Free; END ELSE BEGIN process.AbortXferSequential(xWrite, POINTER(ORD(SELF.dataSegment.preludePtr)), SELF.dataSegment.preludePtr^.docSize, abortChunkSize, fs); fs.Compact; {*** we should set the logical file size to the logical EOF ***} error := fs.error; {*** Be sure buffers are flushed ***} IF error <= 0 THEN IF process.AbortRequest THEN error := erAborted; IF error > 0 THEN BEGIN {$IFC fDbgABC} ABCbreak('In TDocManager.SaveVersion, error saving file=', error); {$ENDC} {this is after we wrote out the file, need a wait alert if user aborted} IF error = erAborted THEN process.BeginWait(phAborting); tmpFile.Delete(localError); {$IFC fDbgABC} IF localError > 0 THEN ABCbreak('In TDocManager.SaveVersion, error deleting file=', localError); {$ENDC} process.EndWait; fs.Free; END ELSE BEGIN fs.FreeObject; {don't free tmpFile yet} IF SELF.files.saveExists THEN BEGIN {$IFC LibraryVersion <= 20} saveFile := TFile.CREATE(NIL, mainHeap, volumePrefix, ''); {$ELSEC} saveFile := TFile.CREATE(NIL, mainHeap, volumePrefix, SELF.files.password); {$ENDC} saveFile.Delete(localError); saveFile.Free; END; SELF.files.saveExists := TRUE; tmpFile.Rename(localError, volumePrefix); {$IFC fDbgABC} IF localError > 0 THEN ABCbreak('In TDocManager.SaveVersion, error renaming file=', localError); {$ENDC} tmpFile.Free; SELF.window.changes := 0; END; END; END; END; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S sStartup} PROCEDURE {TDocManager.}SetSegSize{(VAR error: INTEGER; minSize, maxExcess: LONGINT)}; {Make the memory and disk size of the virtual data segment be at least as indicated, and leave some excess, but no more than the maximum indicated. Update docSize, numSegments, and the refnum table. Assumptions: The virtual data segment exists and is open and bound. It has at least one real data segment, and has a valid heap that fits in the lesser of the current diskSize and the new diskSize. All LONG parameters are rounded up IF necessary to a multiple of 512 before they are used.} VAR preludePtr: TPPrelude; dsInfo: DsInfoRec; oldMemSize: LONGINT; newSize: LONGINT; newSegments: INTEGER; newSegSize: LONGINT; temp: LONGINT; sched_err: INTEGER; BEGIN {$IFC fTrace}BP(7);{$ENDC} error := 0; minSize := LIntMulInt(LIntDivInt(minSize + 511, 512), 512); maxExcess := LIntMulInt(LIntDivInt(maxExcess + 511, 512), 512); preludePtr := SELF.dataSegment.preludePtr; WITH preludePtr^ DO BEGIN Info_DataSeg(error, SELF.dataSegment.refNum[numSegments], dsInfo); IF error > 0 THEN ABCBreak('SetSegSize: Info_Dataseg', error); oldMemSize := dsInfo.mem_size + (maxSegSize*(numSegments-1)); IF (oldMemSize < minSize) OR (oldMemSize > minSize + maxExcess) THEN {need to adjust the segment size} BEGIN newSize := minSize + maxExcess; newSegments := LIntDivLInt(newSize + maxSegSize - 1, maxSegSize); {$IFC fDbgABC} IF (numSegments < 1) OR (numSegments > maxSegments) THEN ABCBreak('SetSegSize: numSegments NOT IN 1..maxSegments', numSegments); IF (newSegments < 1) OR (newSegments > maxSegments) THEN ABCBreak('SetSegSize: newSegments NOT IN 1..maxSegments', newSegments); {$ENDC} IF numSegments > newSegments THEN {kill off whole segments we don't need anymore} SELF.KillSegments(newSegments + 1, numSegments) ELSE IF numSegments < newSegments THEN SELF.MakeSegments(error, numSegments, newSize); {this sets all the segment sizes correctly} {resize the new last segment} newSegSize := newSize - (maxSegSize*(newSegments-1)); {total doc size - size of all segments before last one} Info_DataSeg(error, SELF.dataSegment.refNum[newSegments], dsInfo); IF error > 0 THEN ABCBreak('SetSegSize: Info_Dataseg', error); WITH dsInfo DO BEGIN Sched_Class(sched_err, FALSE); Size_Dataseg(error, SELF.dataSegment.refnum[newSegments], newSegSize-mem_size, temp, newSegSize-disc_size, temp); Sched_Class(sched_err, TRUE); END; {$IFC fDbgABC} IF fExperimenting THEN BEGIN WriteLn('In SetSegSize: newSize=', newSize:1, ' newSegments=', newSegments:1); WITH dsInfo DO WriteLn('newSegSize=',newSegSize:1, ' mem_size=', mem_size:1, ' disc_size=', disc_size:1); END; {$ENDC} IF error > 0 THEN BEGIN {$IFC fDbgABC} WriteLn('In SetSegSize: newSize=', newSize:1, ' newSegments=', newSegments:1); WITH dsInfo DO WriteLn('newSegSize=',newSegSize:1, ' mem_size=', mem_size:1, ' disc_size=', disc_size:1); {$ENDC} ABCBreak('In TDocManager.SetSegSize: Size_Dataseg', error); END ELSE BEGIN docSize := newSize; numSegments := newSegments; END; END; END; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S SgABCcld} PROCEDURE {TDocManager.}Suspend{(VAR error: INTEGER)}; LABEL 1; VAR lastSegClosed: INTEGER; osErr: INTEGER; (*********** THESE VARIABLES ARE NEEDED ONLY IF SUSPEND IS ABORTABLE volumePrefix: TFilePath; ldsn: INTEGER; dsPathname: PathName; dsRefnum: INTEGER; memOrd: LONGINT; reopenedSeg: INTEGER; **********) BEGIN {$IFC fTrace}BP(7);{$ENDC} {$IFC fDbgABC} IF SELF <> boundDocument THEN ABCBreak('Suspend not-bound document', error); {$ENDC} SELF.dataSegment.preludePtr^.docDirectory.window := SELF.window; {In case it somehow changed} error := 0; {*** error return here not very meaningful yet ***} FOR lastSegClosed := 1 TO SELF.dataSegment.preludePtr^.numSegments DO BEGIN Close_Dataseg(osErr, SELF.dataSegment.refnum[lastSegClosed]); LatestError(osErr, error); SELF.dataSegment.refnum[lastSegClosed] := -1; (********** DOES IT MAKE ANY SENSE FOR SUSPEND TO BE ABORTABLE ???? ********** IF process.AbortRequest THEN BEGIN volumePrefix := SELF.files.volumePrefix; FOR reopenedSeg := 1 TO lastSegClosed DO BEGIN ldsn := reopenedSeg + docLdsn-1; dsPathname := CONCAT(volumePrefix, suspendSuffix[reopenedSeg]); Open_DataSeg(osErr, dsPathname, dsRefnum, memOrd, ldsn); LatestError(osErr, error); IF osErr <= 0 THEN BEGIN SELF.dataSegment.refnum[reopenedSeg] := dsRefnum; SetAccess_DataSeg(osErr, dsRefnum, FALSE); {Make writeable} IF osErr > 0 THEN ABCBreak('ReopenDatasegs, SetAccess_DataSeg', osErr); END ELSE GOTO 1; END; IF error <= 0 THEN error := erAborted; GOTO 1; END; **********) END; SELF.dataSegment.changes := 0; boundDocument := NIL; 1: {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$S SgABCcld} PROCEDURE {TDocManager.}Unbind; VAR error: INTEGER; i: INTEGER; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF SELF = boundDocument THEN BEGIN (***** See how things work without this check {$IFC fDbgABC} IF SELF = currentDocument THEN ABCBreak('Unbind currentDocument', ORD(SELF)); {$ENDC} *****) FOR i := 1 TO SELF.dataSegment.preludePtr^.numSegments DO BEGIN Unbind_DataSeg(error, SELF.dataSegment.refnum[i]); IF error > 0 THEN ABCBreak('Unbind_DataSeg', error); END; boundDocument := NIL; END; {$IFC fTrace}EP;{$ENDC} END; {$S sRes} FUNCTION {TDocManager.}WindowWithId{(wmgrID: TWindowID): TWindow}; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF SELF.window.wmgrID = wmgrID THEN WindowWithId := SELF.window ELSE WindowWithId := NIL; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCini} END; METHODS OF TClipboard; {$S SgABCini} FUNCTION {TClipboard.}CREATE{(object: TObject; heap: THeap): TClipboard}; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF object = NIL THEN object := NewObject(heap, THISCLASS); SELF := TClipboard(TDocManager.CREATE(object, heap, '--CLIPBOARD')); WITH SELF DO BEGIN hasView := FALSE; hasPicture := FALSE; hasUniversalText := FALSE; hasIcon := FALSE; cuttingTool := 0; cuttingProcessID := 0; clipCopy := NIL; END; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCres} {$IFC fDebugMethods} {$S SgABCdbg} PROCEDURE {TClipboard.}Fields{(PROCEDURE Field(nameAndType: S255))}; BEGIN TDocManager.Fields(Field); Field('hasView: BOOLEAN'); Field('hasPicture: BOOLEAN'); Field('hasUniversalText: BOOLEAN'); Field('hasIcon: BOOLEAN'); Field('cuttingTool: LONGINT'); Field('cuttingProcessID: LONGINT'); Field('clipCopy: TFileScanner;'); END; {$S SgABCres} {$ENDC} {$S sCut} PROCEDURE {TClipboard.}AboutToCut; BEGIN {$IFC fTrace}BP(7);{$ENDC} InheritScrap(TRUE); {$IFC fTrace}EP;{$ENDC} END; {$S sCut} PROCEDURE {TClipboard.}BeginCut; LABEL 1; VAR heap: THeap; window: TWindow; panel: TPanel; view: TView; selection: TSelection; error: INTEGER; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF boundClipboard = NIL THEN boundClipboard := SELF ELSE ABCBreak('BeginCut: Clipboard already bound', 0); EraseScrapData(error); IF error > 0 THEN BEGIN ABCBreak('EraseScrapData', error); BackOutOfScrap; {need to put up alert that cut was not put into scrap and pass this info back up the ladder} GOTO 1; END; {Obtain write access} StartPutScrap(error); IF error > 0 THEN BEGIN ABCBreak('StartPutScrap', error); BackOutOfScrap; {need to put up alert that cut was not put into scrap and pass this info back up the ladder} GOTO 1; END; {Find out where the Clipboard heap is} heap := POINTER(ORD(hzOfScrap)); SELF.docHeap := heap; {Create a standard window onto the Clipboard} window := SELF.NewWindow(heap, ORD(scrapFolder)); SELF.window := window; panel := TPanel.CREATE(NIL, heap, window, 0, 0, [aScroll, aSplit], [aScroll, aSplit]); {Create a dummy view to be replaced by the application's view} view := panel.NewStatusView(NIL, zeroLRect); clipPrintPref := boundDocument.dataSegment.preludePtr^.printPref; 1: {$IFC fTrace}EP;{$ENDC} END; {$S sPaste} PROCEDURE {TClipboard.}Bind; VAR which: ScrapType; what: TH; docDirectory: TDocDirectory; olderVersion: BOOLEAN; newerVersion: BOOLEAN; error: INTEGER; PROCEDURE CopyScrap; VAR aFile: TFile; fs: TFileScanner; dsInfo: DsInfoRec; BEGIN aFile := TFile.CREATE(NIL, mainHeap, 'TKScrapCopy', ''); fs := aFile.Scanner; SELF.clipCopy := fs; Info_Dataseg(error, DSegOfScrap, dsInfo); {$IFC fDbgABC} IF error > 0 THEN ABCbreak('CopyScrap: error from Info_Dataseg', error); {$ENDC} WITH dsInfo DO fs.XferSequential(xWrite, Ptr(AddrOfScrapDSeg), mem_size); END; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF boundClipboard <> SELF THEN BEGIN IF boundClipboard <> NIL THEN boundClipboard.Unbind; boundClipboard := SELF; {Open the clipboard data segment} StartGetScrap(error); IF error > 0 THEN BEGIN ABCBreak('StartGetScrap', error); BackOutOfScrap; {need to put up alert that scrap cannot be bound and pass this info back up the ladder} END ELSE BEGIN {Obtain write access} SetAccess_DataSeg(error, DSegOfScrap, FALSE); IF error > 0 THEN ABCBreak('SetAccess_DataSeg', error); {Find out what is there to be pasted} GetScrap(which, what); SELF.window := NIL; {$IFC LibraryVersion > 20} IF scrapProcess = myProcessID THEN IF which = scrapRef THEN BEGIN which := toolKitType; what := Pointer(Ord(GetFldrRefCon(scrapFolder))); END; {$ENDC} IF which = toolKitType THEN BEGIN docDirectory := POINTER(ORD(what)); (**) (*^*) IF scrapProcess <> myProcessID THEN {Don't waste time checking if I put it there myself} IF NeedConversion(docDirectory.classWorld, olderVersion, newerVersion) THEN BEGIN CopyScrap; {*** Should defer until app likes selection class ***} (*** ClaimScrap; ***) (*^*) ConvertHeap(POINTER(ORD(HzOfScrap)), docDirectory.classWorld); docDirectory.Adopt; (*^*) END; (**) SELF.window := docDirectory.window; END; {Record attributes of the clipboard data that the application might want to inquire about} SELF.Inspect; END; END; {$IFC fTrace}EP;{$ENDC} END; {$S sCut} PROCEDURE {TClipboard.}CommitCut; BEGIN {$IFC fTrace}BP(7);{$ENDC} AcceptInheritScrap; {$IFC fTrace}EP;{$ENDC} END; {$S sCut} PROCEDURE {TClipboard.}EndCut; VAR window: TWindow; clipSel: TSelection; docDirectory: TDocDirectory; error: INTEGER; BEGIN {$IFC fTrace}BP(7);{$ENDC} window := SELF.window; clipSel := window.selectPanel.selection; IF clipSel.kind = nothingKind THEN BEGIN {$IFC fDbgABC} ABCBreak('No selection in Clipboard at EndCut', 0); {$ENDC} BackOutOfScrap; {need to put up an alert and pass info up the ladder} END ELSE BEGIN {Display the Clipboard} PushFocus; window.Focus; window.Refresh([rErase, rFrame, rBackground, rDraw], hNone); PopFocus; {Inform others of what TWindow is there to be pasted} docDirectory := TDocDirectory.CREATE(NIL, SELF.docHeap, window, myWorld); PutScrap(toolKitType, POINTER(ORD(docDirectory)), error); {Record attributes of the clipboard data that the application might want to inquire about} SELF.Inspect; {Relinquish write access} EndPutScrap(error); IF error > 0 THEN ABCBreak('EndPutScrap', error); END; SELF.window := NIL; boundClipboard := NIL; {$IFC fTrace}EP;{$ENDC} END; {$S sCldInit} PROCEDURE {TClipboard.}Inspect; VAR which: ScrapType; what: TH; pic: PicHandle; BEGIN {$IFC fTrace}BP(7);{$ENDC} {$H-} SELF.docHeap := POINTER(ORD(HzOfScrap)); {$H+} GetScrap(which, what); SELF.hasView := which = toolKitType; {$H-} GetGrScrap(pic); {$H+} SELF.hasPicture := pic <> NIL; SELF.hasUniversalText := (scrapCs IN currScrapSet); {$IFC LibraryVersion > 20} SELF.hasIcon := which = scrapRef; {$ENDC} SELF.cuttingProcessID := scrapProcess; {$H-} SELF.cuttingTool := ToolOfProcess(scrapProcess); {$H+} {$IFC fTrace}EP;{$ENDC} END; {$S SgABCcld} PROCEDURE {TClipboard.}Publicize; VAR window: TWindow; panel: TPanel; pane: TPane; viewExtentLRect: LRect; info: WindowInfo; picLRect: LRect; tempHeap: THeap; picRect: Rect; tempPad: TPad; pic: PicHandle; error: INTEGER; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF scrapProcess = myProcessID THEN BEGIN SELF.Bind; window := SELF.window; IF window <> NIL THEN {LSR} BEGIN {LSR} panel := TPanel(window.panels.First); pane := TPane(panel.panes.First); viewExtentLRect := window.selectPanel.view.extentLRect; {Let the Window Manager have a picture to display while inactive [if open]} GetWindInfo(POINTER(window.wmgrID), info); IF info.visible THEN window.StashPicture(hNone); {Let others have a picture to paste} noPad.RectToLRect(hugeRect, picLRect); IF SectLRect(viewExtentLRect, picLRect, picLRect) AND NOT EmptyLRect(picLRect) THEN BEGIN GetHeap(tempHeap); SetHeap(POINTER(ORD(HzOfScrap))); {Before calling Focus, set up everything for unclipped drawing of the view} tempPad := TPad.CREATE(NIL, mainHeap, hugeRect, picLRect, screenRes, screenRes, thePort); tempPad.LRectToRect(picLRect, picRect); RectRgn(altVisRgn, picRect); useAltVisRgn := TRUE; { enable clipping to whole picture } {Focus on the Clipboard} PushFocus; tempPad.Focus; focusArea := NIL; {To trap illegal attempts to Push/PopFocus during TView.Draw} {Generate the Universal Picture} pic := OpenPicture(picRect); genClipPic := TRUE; { enable putting comments into picture } PicComment(cPicGeDwg, 0, NIL); { needed for pasting into LisaDraw } PicGrpBegin; { every LisaDraw picture from other apps is a group } panel.view.Draw; { tell the application to draw now } PicGrpEnd; ClosePicture; {Put it in the Clipboard} PutGrScrap(pic, error); IF error > 0 THEN ABCBreak('PutGrScrap', error); {Generate the Universal Text} panel.view.CreateUniversalText; {Unravel} genClipPic := FALSE; { disable putting comments into picture } useAltVisRgn := FALSE; { disable clipping to whole window } PopFocus; tempPad.Free; SetHeap(tempHeap); END; END; {LSR} SELF.Unbind; END; {$IFC fTrace}EP;{$ENDC} END; {$S sPaste} PROCEDURE {TClipboard.}Unbind; VAR error: INTEGER; PROCEDURE RestoreScrap; VAR fs: TFileScanner; BEGIN fs := SELF.clipCopy; IF fs <> NIL THEN BEGIN fs.XferRandom(xRead, Ptr(AddrOfScrapDSeg), fs.actual, fAbsolute, 0); fs.Free; SELF.clipCopy := NIL; END; END; BEGIN {$IFC fTrace}BP(7);{$ENDC} IF SELF = boundClipboard THEN BEGIN RestoreScrap; {$IFC fDbgABC} IF SELF = currentDocument THEN ABCBreak('TClipboard.Unbind currentDocument', ORD(SELF)); {$ENDC} boundClipboard := NIL; {Relinquish access} SELF.window := NIL; EndGetScrap(error); IF error > 0 THEN ABCBreak('EndGetScrap', error); END; {$IFC fTrace}EP;{$ENDC} END; {$S sCut} FUNCTION {TClipboard.}UndoCut{: BOOLEAN}; VAR clipErr: INTEGER; BEGIN {$IFC fTrace}BP(7);{$ENDC} UndoInheritScrap(clipErr); SELF.Inspect; {so app can inquire} (* IF (clipErr <= 0) AND SELF.hasView THEN * WRONG BECAUSE SELF.window MAY BELONG TO ANOTHER TK APP * BEGIN SELF.Bind; SELF.window.Resize(FALSE); {in case clipboard resized between the cut and the undo-cut} SELF.Unbind; END; *) UndoCut := clipErr <= 0; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCini} END; METHODS OF TCommand; {$S sCommand} FUNCTION {TCommand.}CREATE{(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber; itsImage: TImage; isUndoable: BOOLEAN; itsRevelation: TRevelation): TCommand}; VAR cmdPhase: TCmdPhase; BEGIN {$IFC fTrace}BP(6);{$ENDC} IF object = NIL THEN object := NewObject(heap, THISCLASS); SELF := TCommand(object); WITH SELF DO BEGIN cmdNumber := itsCmdNumber; image := itsImage; undoable := isUndoable; doing := FALSE; revelation := itsRevelation; FOR cmdPhase := doPhase TO redoPhase DO BEGIN unHiliteBefore[cmdPhase] := TRUE; hiliteAfter[cmdPhase] := TRUE; END; END; {$IFC fTrace}EP;{$ENDC} END; {$IFC fDebugMethods} {$S SgABCdbg} PROCEDURE {TCommand.}Fields{(PROCEDURE Field(nameAndType: S255))}; BEGIN Field('cmdNumber: INTEGER'); Field('image: TImage'); Field('undoable: BOOLEAN'); Field('doing: BOOLEAN'); Field('revelation: Byte'); Field('unHiliteBefore: ARRAY[0..2] OF BOOLEAN'); Field('hiliteAfter: ARRAY[0..2] OF BOOLEAN'); Field(''); END; {$S SgABCres} {$ENDC} {$S sCommand} PROCEDURE {TCommand.}Commit; BEGIN {$IFC fTrace}BP(7);{$ENDC} {$IFC fTrace}EP;{$ENDC} END; {$S sFilter} PROCEDURE {TCommand.}EachVirtualPart{(PROCEDURE DoToObject(filteredObj: TObject))}; PROCEDURE DoToFilteredObject(actualObj: TObject); BEGIN SELF.FilterAndDo(actualObj, DoToObject); END; BEGIN {$IFC fTrace}BP(11);{$ENDC} IF SELF.image <> NIL THEN SELF.image.EachActualPart(DoToFilteredObject) ELSE currentWindow.EachActualPart(DoToObject); {$IFC fTrace}EP;{$ENDC} END; {$S sFilter} PROCEDURE {TCommand.}FilterAndDo{(actualObj: TObject; PROCEDURE DoToObject(filteredObj: TObject))}; BEGIN {$IFC fTrace}BP(11);{$ENDC} DoToObject(actualObj); {$IFC fTrace}EP;{$ENDC} END; {$S sCommand} PROCEDURE {TCommand.}Perform{(cmdPhase: TCmdPhase)}; BEGIN {$IFC fTrace}BP(7);{$ENDC} {$IFC fTrace}EP;{$ENDC} END; {$S SgABCini} END; {$S SgABCres} METHODS OF TCutCopyCommand; {$S sCut} FUNCTION {TCutCopyCommand.}CREATE{(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber; itsImage: TImage; isCutCmd: BOOLEAN): TCutCopyCommand}; BEGIN {$IFC fTrace}BP(6);{$ENDC} IF object = NIL THEN object := NewObject(heap, THISCLASS); SELF := TCutCopyCommand(TCommand.CREATE(object, heap, itsCmdNumber, itsImage, TRUE, revealAll)); SELF.isCut := isCutCmd; {$IFC fTrace}EP;{$ENDC} END; {$IFC fDebugMethods} {$S SgABCdbg} PROCEDURE {TCutCopyCommand.}Fields{(PROCEDURE Field(nameAndType: S255))}; BEGIN SUPERSELF.Fields(Field); Field('isCut: BOOLEAN'); Field(''); END; {$S SgABCcld} {$ENDC} {$S sCut} PROCEDURE {TCutCopyCommand.}Commit; BEGIN {$IFC fTrace}BP(7);{$ENDC} clipboard.CommitCut; {$IFC fTrace}EP;{$ENDC} END; {$S Override} PROCEDURE {TCutCopyCommand.}DoCutCopy{(clipSelection: TSelection; deleteOriginal: BOOLEAN; cmdPhase: TCmdPhase)}; BEGIN {$IFC fTrace}BP(7);{$ENDC} {$IFC fTrace}EP;{$ENDC} END; {$S sCut} PROCEDURE {TCutCopyCommand.}Perform{(cmdPhase: TCmdPhase)}; BEGIN {$IFC fTrace}BP(7);{$ENDC} CASE cmdPhase OF doPhase: BEGIN clipboard.AboutToCut; clipboard.BeginCut; SELF.DoCutCopy(clipboard.window.selectPanel.selection, SELF.isCut, cmdPhase); clipboard.EndCut; END; undoPhase: BEGIN IF SELF.isCut THEN BEGIN IF NOT clipboard.hasView THEN ABCbreak('undoing Cut but clipboard has no view', 0) ELSE BEGIN clipboard.Bind; IF clipboard.window = NIL THEN ABCbreak('undoing Cut but clipboard.window = NIL', 0) ELSE SELF.DoCutCopy(clipboard.window.selectPanel.selection, TRUE, cmdPhase); clipboard.Unbind; END; END ELSE SELF.DoCutCopy(NIL, FALSE, cmdPhase); IF NOT clipboard.UndoCut THEN BEGIN {$IFC fDbgABC} ABCbreak('clipboard.UndoCut returns FALSE', 0); {$ENDC} END; END; redoPhase: BEGIN IF NOT clipBoard.UndoCut THEN BEGIN ABCbreak('clipboard.UndoCut returns FALSE', 0); END ELSE BEGIN clipboard.Bind; IF NOT clipboard.hasView THEN ABCbreak('re-doing Cut/Copy but clipboard has no view', 0) ELSE SELF.DoCutCopy(clipboard.window.selectPanel.selection, SELF.isCut, cmdPhase); clipboard.Unbind; END; END; END; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCini} END; {$S SgABCres} METHODS OF TPasteCommand; {$S sPaste} FUNCTION {TPasteCommand.}CREATE{(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber; itsImage: TImage): TPasteCommand}; BEGIN {$IFC fTrace}BP(6);{$ENDC} IF object = NIL THEN object := NewObject(heap, THISCLASS); SELF := TPasteCommand(TCommand.CREATE(object, heap, itsCmdNumber, itsImage, TRUE, revealAll)); {$IFC fTrace}EP;{$ENDC} END; {$S Override} PROCEDURE {TPasteCommand.}DoPaste{(clipSelection: TSelection; pic: PicHandle; cmdPhase: TCmdPhase)}; BEGIN {$IFC fTrace}BP(7);{$ENDC} {$IFC fTrace}EP;{$ENDC} END; {$S sPaste} PROCEDURE {TPasteCommand.}Perform{(cmdPhase: TCmdPhase)}; VAR window: TWindow; pic: PicHandle; selection: TSelection; BEGIN {$IFC fTrace}BP(7);{$ENDC} CASE cmdPhase OF doPhase, redoPhase: IF NOT (clipboard.hasPicture OR clipboard.hasView OR clipboard.hasUniversalText) THEN IF currScrapSet = [] THEN process.Stop(phNoClip) ELSE process.Stop(phUnkClip) ELSE BEGIN clipboard.Bind; {$H-} GetGrScrap(pic); {$H+} window := clipboard.window; IF window = NIL THEN SELF.DoPaste(NIL, pic, cmdPhase) ELSE BEGIN selection := window.selectPanel.selection; IF selection.Class = cSelection THEN SELF.DoPaste(NIL, pic, cmdPhase) ELSE SELF.DoPaste(selection, pic, cmdPhase); END; clipboard.Unbind; END; undoPhase: SELF.DoPaste(NIL, NIL, cmdPhase); END; {$IFC fTrace}EP;{$ENDC} END; {$S SgABCini} END; {$S SgABCres}